时间戳

首页 > 解决方案 > VBA 匹配具有不同行索引的两个工作表之间的行

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

问题描述

我有一个匹配两张表中的行的代码，并将匹配的行粘贴到 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（差异表）中

标签： excelvbamatch

解决方案

添加消息框以识别不匹配的键

    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

推荐阅读