数据比对与差异分析

两张数据表自动比对

Sub CompareData()
    Dim wsA As Worksheet, wsB As Worksheet, wsR As Worksheet
    Dim dict As Object
    Dim lastRowA As Long, lastRowB As Long
    Dim i As Long, r As Long

    Set wsA = Sheets("数据表A")
    Set wsB = Sheets("数据表B")
    Set wsR = Sheets("比对结果")
    Set dict = CreateObject("Scripting.Dictionary")

    lastRowA = wsA.Cells(Rows.Count, 1).End(xlUp).Row
    lastRowB = wsB.Cells(Rows.Count, 1).End(xlUp).Row

    ' 将表A数据存入字典
    For i = 2 To lastRowA
        dict(wsA.Cells(i, 2).Value) = wsA.Rows(i).Address
    Next

    r = 3
    For i = 2 To lastRowB
        key = wsB.Cells(i, 2).Value
        If dict.exists(key) Then
            wsR.Cells(r, 1).Value = "存在"
            dict.Remove key
        Else
            wsR.Cells(r, 1).Value = "新增"
            wsB.Rows(i).Copy wsR.Cells(r, 2)
        End If
        r = r + 1
    Next

    For Each key In dict.keys
        wsR.Cells(r, 1).Value = "已删除"
        wsR.Cells(r, 2).Value = key
        r = r + 1
    Next

    MsgBox "比对完成！结果已写入「比对结果」表"
End Sub