如果在 A 列中找不到匹配项，请使用 VBA 将整行从一个 excel 工作表复制到另一个

Question

我在尝试使用 VBA 比较不同工作表中的 2 个表，然后复制“主”表中未在“新”表中找到的任何行时遇到了一些问题。 两个表都格式化为表格。 匹配基于两个表的 A 列中的“ID”列。 如果 ID 在“主”工作表中，但不在“新”工作表中，则应将整行复制并粘贴到“新”工作表中表格的末尾。

我更新了在另一个论坛中找到的一些代码，这几乎可以正常工作。 但是，它似乎只是将 ID 数据粘贴到 A 列中，而不是将所需的整个相应数据行粘贴。

Sub compare()
Dim i As Long
Dim lrs As Long
Dim lrd As Long

With Worksheets("Master")
    lrs = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lrs 'assumes header in row 1
        If Application.IfError(Application.Match(.Cells(i, 1), Worksheets("New").Columns(1), 0), 0) = 0 Then
            lrd = Worksheets("New").Cells(Worksheets("test").Rows.Count, 1).End(xlUp).Row
            Worksheets("New").Cells(lrd + 1, 1).Value = .Cells(i, 1).Value
        End If
    Next i
End With
End Sub

我认为问题与“单元格”参考有关，而不是范围，但我不知道如何使该行动态化。

Answer 1

方法略有不同，但您需要使用类似Resize()的方法来捕获整行，而不仅仅是 Col A 中的单元格。

Sub compare()
    Const NUM_COLS As Long = 10 'for example
    Dim wb As Workbook, wsSrc As Worksheet, wsDest As Worksheet
    Dim c As Range, cDest As Range
    
    Set wb = ThisWorkbook 'or ActiveWorkbook for example
    Set wsSrc = wb.Worksheets("Master")
    Set wsDest = wb.Worksheets("New")
    Set cDest = wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1) 'next empty row

    For Each c In wsSrc.Range("A2:A" & wsSrc.Cells(Rows.Count, 1).End(xlUp).Row).Cells
        If IsError(Application.Match(c.Value, wsDest.Columns(1), 0)) Then
            cDest.Resize(1, NUM_COLS).Value = c.Resize(1, NUM_COLS).Value
            Set cDest = cDest.Offset(1) 'next row
        End If
    Next c
End Sub