VBA 字典 两表核对数据

Sub GetData(control As IRibbonControl)
    Dim Dic As Object
    Dim aData, arr, aRes, N, Mat
    Dim intX&, MaxN&
    aData = Range("A1").CurrentRegion
    arr = Range("C1").CurrentRegion
    MaxN = IIf(UBound(aData) > UBound(arr), UBound(aData), UBound(arr))
    ReDim aRes(1 To MaxN, 1 To 5)
    N = Array(1, 1, 1)
    Set Dic = CreateObject("Scripting.Dictionary")
    For intX = 2 To UBound(aData) '循环遍历数据1的数据源
        Dic(aData(intX, 1)) = "数据1" '名字作为关键字写入字典,对应的Item为数据1
        aRes(intX, 1) = aData(intX, 1)
    Next
    For intX = 2 To UBound(arr)
        If Dic.exists(arr(intX, 1)) Then '判断字典中是否包含关键字
            N(0) = N(0) + 1 '计数器累加
            aRes(N(0), 3) = arr(intX, 1) '写入结果数组
            Dic(arr(intX, 1)) = "相同" '修改关键字对应的条目
        Else
            N(1) = N(1) + 1
            aRes(N(1), 4) = arr(intX, 1)
            Dic(arr(intX, 1)) = "数据2" '名字作为关键字写入字典,对应的Item为数据2
        End If
        aRes(intX, 2) = arr(intX, 1)
    Next
    For Each Mat In Dic.keys '遍历字典中的Key
        If Dic(Mat) = "数据1" Then '判断关键字对应的条目是否数据1
            N(2) = N(2) + 1
            aRes(N(2), 5) = Mat
        End If
    Next
    aRes(1, 1) = "数据1": aRes(1, 2) = "数据2": aRes(1, 3) = "两表相同": aRes(1, 4) = "数据2独有": aRes(1, 5) = "数据1独有"
    Range("E1").Resize(UBound(aRes), UBound(aRes, 2)) = aRes
    Set Dic = Nothing
End Sub