Excel VBA将多个匹配项导入同一行的不同列中

我试图从另一个wb导入单元格。 因此，如果wb1中的单元格col H匹配wb2 col K中的单元格，则wb1 col k和L = wb2 col C和E在匹配行中。 现在可能有几个匹配，所以我想它抵消到下一列。 下一个是m和n，下一个是o和p，依此类推。

这是我迄今为止：

Private Sub CommandButton1_Click() Dim rcell As Range, sValue As String Dim lcol As Long, cRow As Long Dim dRange As Range, sCell As Range Dim LastRow As Integer Dim CurrentRow As Integer Set ws1 = ThisWorkbook Set ws2 = Workbooks("Workbook2").Worksheets("Sheet1") Sheet1LastRow = ThisWorkbook.Sheets("Data").Range("H2:H50000").Value 'Search criteria column Sheet2LastRow = Workbooks("Workbook2").Worksheets("Sheet1").Range("Q" & Rows.Count).End(xlUp).Row 'Where to look for matches With Workbooks("Workbook2").Worksheets("Sheet1") For j = 1 To Sheet1LastRow For i = 1 To Sheet2LastRow If ThisWorkbook.Sheets("Data").Range("H").Value = ws2.Cells(i, 11).Value Then ws2.Cells(i, 11).Value = ThisWorkbook.Sheets("Data").Range("C").Value ws2.Cells(i, 12).Value = ThisWorkbook.Sheets("Data").Range("E").Value End If If InStr(1, ws2.Cells.Value, ws1.Cells.Value) And Trim(ws1.Cells.Value) <> "" Then rcell.Offset(0, lcol).Value = ws2.Cells.Offset(0, 2).Value lcol = lcol + 1 End If Next i Next j End With End Sub 

这不起作用。 我基本上放弃了，因为我不知道我错过了什么。

我寻找这样的东西，但只发现了一个Vlookup或Match可以做的事情。

Answer 1

您可以通过跟踪在复制每次比赛后偏移两次的偏移量来完成。 我将在一个名为offs的variables中跟踪这个。 此外，我想假设复制从wb2到wb1如文中所述，而不是在代码中“怀疑”。

 Private Sub CommandButton1_Click() Dim cel1 As Range, cel2 As Range For Each cel1 In ThisWorkbook.Sheets("Data").UsedRange.Columns("H").Cells Dim offs As Long: offs = 3 ' <-- Initial offset, will increase by 2 after each match For Each cel2 In Workbooks("Workbook2").Worksheets("Sheet1").UsedRange.Columns("K").Cells If cel1.Value = cel2.Value Then cel1.offset(, offs).Value = cel2.offset(, -8).Value ' <- wb2(C) to wb1(K) cel1.offset(, offs + 1).Value = cel2.offset(, -6).Value ' <- wb2(E) to wb1(L) offs = offs + 2 ' <-- now shift the destination column by 2 for next match End If Next Next End Sub