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

Question

我正在尝试从另一个 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 的变量中跟踪它。 此外，我认为复制是 从 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