VBA 匹配具有不同行索引的两个工作表之间的行

Question

我有一个代码匹配两个 sheet 中的行，并将匹配的行粘贴到 sheet3 中，将不匹配的行粘贴到 sheet4 中。当 sheet1 中的第一行与 sheet2 中的第一行匹配时，会出现正确的输出。问题是 sheet4

中没有显示有差异的行

谁能帮帮我，我哪里弄错了？我想要一个只匹配行的代码，无论它们有哪个行索引。每个输入可能会有所不同。

我的代码是：

Sub MatchRows()

    Dim a As Variant, b As Variant, c As Variant, d As Variant
    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    Dim dic As Object, ky As String

    Set dic = CreateObject("Scripting.Dictionary")
    a = Sheets("Sheet1").Range("A2:I" & Sheets("Sheet1").Range("H" & Rows.Count).End(3).Row).Value
    b = Sheets("Sheet2").Range("A2:I" & Sheets("Sheet2").Range("H" & Rows.Count).End(3).Row).Value
    ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
    ReDim d(1 To UBound(a, 1), 1 To UBound(a, 2))

    For i = 1 To UBound(b, 1)
        ky = b(i, 3) & "|" & b(i, 4) & "|" & b(i, 5) & "|" & b(i, 9)
        dic(ky) = i
    Next

    For i = 1 To UBound(a, 1)
        ky = a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5) & "|" & a(i, 9)
        If dic.exists(ky) Then
            j = dic(ky)
            If a(i, 8) = b(j, 8) Then
                k = k + 1
                For n = 1 To UBound(a, 2)
                    c(k, n) = a(i, n)
                Next
                c(k, 8) = 0
            Else
                m = m + 1
                For n = 1 To UBound(a, 2)
                    d(m, n) = a(i, n)
                Next
                d(m, 8) = a(i, 8) - b(j, 8)
            End If
        Else
            MsgBox "'" & ky & "' not matched on row " & i + 1   
        End If
    Next

    If k > 0 Then Sheets("Sheet3").Range("A" & Rows.Count).End(3)(2).Resize(k, UBound(a, 2)).Value = c
    If m > 0 Then Sheets("Sheet4").Range("A" & Rows.Count).End(3)(2).Resize(m, UBound(a, 2)).Value = d

End Sub

尽管它们在 sheet1 和 sheet2 中位于不同的行索引上，但这些行匹配，这很好。现在的问题是存在差异的行未显示在 sheet4（差异 sheet）

中

Answer 1

添加一个消息框来识别不匹配的键

    For i = 1 To UBound(a, 1)
        ky = a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5) & "|" & a(i, 9)
        If dic.exists(ky) Then
            j = dic(ky)
            If a(i, 8) = b(j, 8) Then
                k = k + 1
                For n = 1 To UBound(a, 2)
                    c(k, n) = a(i, n)
                Next
                c(k, 8) = 0
            Else
                m = m + 1
                For n = 1 To UBound(a, 2)
                    d(m, n) = a(i, n)
                Next
                d(m, 8) = a(i, 8) - b(j, 8)
            End If
        Else
            MsgBox "'" & ky & "' not matched on row " & i + 1
        End If
    Next

VBA 匹配具有不同行索引的两个工作表之间的行

VBA match rows between two sheets with different row indexes

excel

vba

match