Excel VBA多Sheet行匹配仅1条差异记录输出问题求助

问题根因 #

• 核心错误：差异数据存入结果数组时，误用了Sheet3匹配行的计数器k作为索引，实际应该用差异行专属的计数器m。当匹配记录和差异记录交替出现时，会导致差异数据被覆盖、输出缺失。
• 额外错误：完全匹配的行逻辑中，错误将H列赋值为0，不符合「整行粘贴」的原始需求。

修复后完整代码 #

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("A1:I" & Sheets("Sheet1").Range("H" & Rows.Count).End(3).Row).Value
    b = Sheets("Sheet2").Range("A1: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 = 2 To UBound(b, 1)
        ky = b(i, 3) & "|" & b(i, 4) & "|" & b(i, 5) & "|" & b(i, 9)
        dic(ky) = i
    Next

    For i = 2 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
            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
        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

     Sheets(3).UsedRange.Columns.AutoFit
     Sheets(4).UsedRange.Columns.AutoFit
End Sub

内容的提问来源于stack exchange，提问作者user14345147