匹配两张纸中的单元格并复制粘贴匹配内容

Question

我对 vba 完全陌生。我有两张 Excel 表格，我正在尝试比较和匹配两张表格中的一列中的单元格。如果找到匹配的单元格，则将相邻单元格的信息复制并粘贴到另一张表（sheet1）。

我有一个工作正常但不完整的代码。因为一列中有重复的单元格，代码一旦找到匹配并复制粘贴信息，它就会跳到下一个非重复的单元格。从而导致大量空白、缺失单元格。有什么想法让它填补空白吗？

图片：

表 2：

Sub Button2_Click()
Dim lastRw1, lastRw2, nxtRw, m

  lastRw1 = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
  lastRw2 = Sheets(2).Range("B" & Rows.Count).End(xlUp).Row
'Loop
     For nxtRw = 2 To lastRw2
'Search
        With Sheets(1).Range("A2:A" & lastRw1)
          Set m = .Find(Sheets(2).Range("B" & nxtRw), LookIn:=xlValues, lookat:=xlWhole)
'Copy
            If Not m Is Nothing Then
              Sheets(2).Range("C" & nxtRw & ":D" & nxtRw).Copy _
              Destination:=Sheets(1).Range("J" & m.Row)
            End If
        End With
     Next
End Sub

Answer 1

更新：

我从您的 Sheet2 数据集中抽取了一个小样本：

我还更新了您的代码如下（主要更改 - 我将 Find 替换为 Match 以查找匹配的行号）：

Dim lastRw1 As Long, lastRw2 As Long, nxtRw As Long, m As Long

lastRw1 = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
lastRw2 = Sheets(2).Range("B" & Rows.Count).End(xlUp).Row

'Loop
 For nxtRw = 2 To lastRw1
    'Search
    With Sheets(1)
         m = Application.Match(.Range("A" & nxtRw).Value, _
                Sheets(2).Range("B1:B" & lastRw2), 0)
        'Copy
         If m Then
            Sheets(2).Range("C" & m & ":D" & m).Copy _
            Destination:=.Range("J" & nxtRw)
         End If
    End With
 Next

最终结果：