如何比较2张纸中的行，然后将不同的行复制到另一张纸vba

Question

我有 2 张纸：

表 1：

表 2：

我正在比较工作表 1 和工作表 2 中的行，但不包括两者的第一列。我在网上找到了以下代码，但它返回没有不匹配的行。但是，在表 2 中，c 有一个额外的行，其值为 8.00 美元，而在表 1 中没有。那是我希望复制到表 3 中的那个。

当我运行此代码时，它表示工作表之间没有差异，但工作表 2 中肯定有一个额外的行在工作表 1 中找不到，不包括日期的第一列。

有人可以帮忙吗？

Sub Compare()
    '
    ' Macro1 Macro
    '
    ' compare two different worksheets in the active workbook
    CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
    Dim dupRow As Boolean
    Dim r As Long, c As Integer, m As Integer
    Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer, lr3 As Long
    Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
    Dim dupCount As Long

    Application.ScreenUpdating = False
    Application.StatusBar = "Creating the report..."
    Application.DisplayAlerts = True
    With ws1.UsedRange
        lr1 = .Rows.Count
        lc1 = .Columns.Count
    End With
    With ws2.UsedRange
        lr2 = .Rows.Count
        lc2 = .Columns.Count
    End With
    maxR = lr1
    maxC = lc1
    If maxR < lr2 Then maxR = lr2
    If maxC < lc2 Then maxC = lc2
    DiffCount = 0
    lr3 = 1
    For i = 1 To lr1
        dupRow = True
        Application.StatusBar = "Comparing worksheets " & Format(i / maxR, "0 %") & "..."
        For r = 1 To lr2
            For c = 2 To maxC
                ws1.Select
                cf1 = ""
                cf2 = ""
                On Error Resume Next
                cf1 = ws1.Cells(i, c).FormulaLocal
                cf2 = ws2.Cells(r, c).FormulaLocal
                On Error GoTo 0
                If cf1 <> cf2 Then
                    dupRow = False
                    Exit For
                Else
                    dupRow = True
                End If
            Next c
            If dupRow Then
                Exit For
            End If
        Next r
        If Not dupRow Then
            dupCount = dupCount + 1
            ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, maxC)).Select
            Selection.Copy
            Worksheets("Sheet3").Select
            Worksheets("Sheet3").Range(Worksheets("Sheet3").Cells(lr3, 1), Worksheets("Sheet3").Cells(lr3, maxC)).Select
            Selection.PasteSpecial
            lr3 = lr3 + 1
            ws1.Select
            For t = 1 To maxC
                ws1.Cells(i, t).Interior.ColorIndex = 19
                ws1.Cells(i, t).Select
                Selection.Font.Bold = True
            Next t
        End If
    Next i
    Application.StatusBar = "Formatting the report..."
    'Columns("A:IV").ColumnWidth = 10
    m = dupCount
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox m & " Rows contain different values!", vbInformation, _
           "Compare " & ws1.Name & " with " & ws2.Name


     End Sub

Answer 1

您的代码仅检查 Sheet1 中的任何行是否在 Sheet2 中重复。您没有检查其他方式（Sheet2 到 Sheet1）。在您的示例中，如果您将 Sheet2 作为第一个参数传递，您将得到正确的结果。

CompareWorksheets Worksheets("Sheet2"), Worksheets("Sheet1")

但这可能不适用于在 Sheet1 和 Sheet2 中都有一些唯一行的另一组。为此，您可以使用您的逻辑，但请记住将重复的行号存储在 Sheet2 中。最后，还要在 Sheet3 中包含未标记为重复的行。