比较两个Excel工作表并在新工作表中显示新数据

时间:2018-05-23 14:12:06

标签: excel vba excel-vba

我在这个平台上讨论的所有主题中找到了我的问题的答案,例如比较两张表并找到差异,宏来比较两个工作表和&强调差异等......但我没有找到我想要的东西。

我的问题是;有没有可能比较两个excel工作表与不同的布局如下?我愿意将历史工作表与新工作表进行比较,并在第三个工作表中显示新工作表中的历史记录中不存在的内容,例如:

enter image description here

我希望你能理解我的问题,并能够帮助我解决这个问题。我已经有一个代码比较两个工作表并显示差异,但这对我的问题还不够。

Option Explicit

Sub CompareIt()
    Dim ar As Variant
    Dim arr As Variant
    Dim Var As Variant
    Dim v()
    Dim i As Long
    Dim n As Long
    Dim j As Long
    Dim str As String

    ar = Sheet1.Cells(10, 1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        ReDim v(1 To UBound(ar, 2))
        For i = 2 To UBound(ar, 1)
            For n = 1 To UBound(ar, 2)
                str = str & Chr(2) & ar(i, n)
                v(n) = ar(i, n)
            Next
            .Item(str) = v: str = ""
        Next
        ar = Sheet2.Cells(10, 1).CurrentRegion.Resize(, UBound(v)).Value
        For i = 2 To UBound(ar, 1)
            For n = 1 To UBound(ar, 2)
                str = str & Chr(2) & ar(i, n)
                v(n) = ar(i, n)
            Next
            If .exists(str) Then
                .Item(str) = Empty
            Else
                .Item(str) = v
            End If
            str = ""
        Next
        For Each arr In .keys
            If IsEmpty(.Item(arr)) Then .Remove arr
        Next
        Var = .items: j = .Count
    End With
    With Sheet3.Range("a1").Resize(, UBound(ar, 2))
        .CurrentRegion.ClearContents
        .Value = ar
        If j > 0 Then
            .Offset(1).Resize(j).Value = Application.Transpose(Application.Transpose(Var))
        End If
    End With
End Sub

提前致谢

0 个答案:

没有答案