Sub CheckTwoClnData()
    Dim d As Object
    Dim i As Long, n1 As Long, n2 As Long, n3 As Long, m As Long
    Dim strTemp As String
    Dim arr1 As Variant, arr2 As Variant, brr As Variant, kr As Variant
    Dim rng1 As Range, rng2 As Range, rng As Range
    Set d = CreateObject('scripting.dictionary')
    On Error Resume Next
    Set rng1 = Application.InputBox('請(qǐng)選擇需要核對(duì)差異的第一列數(shù)據(jù)', Type:=8)
    '用戶選取第一列數(shù)據(jù)
    If rng1.Columns.Count > 1 Then MsgBox '請(qǐng)選擇單列數(shù)據(jù)。': Exit Sub
    If rng1.Rows.Count = 1 Then MsgBox '不能選擇單個(gè)單元格。': Exit Sub
    Set rng1 = Intersect(rng1.Parent.UsedRange, rng1)
    '防止用戶選取整列造成運(yùn)算量虛大效率低下
    If Not rng1 Is Nothing Then arr1 = rng1.Value
    '將第一列數(shù)據(jù)裝入arr1
    Set rng2 = Application.InputBox('請(qǐng)選擇需要核對(duì)差異的第二列數(shù)據(jù)', Type:=8)
    '用戶選取第二列數(shù)據(jù)
    If rng2.Columns.Count > 1 Then MsgBox '請(qǐng)選擇單列數(shù)據(jù)。': Exit Sub
    If rng2.Rows.Count = 1 Then MsgBox '不能選擇單個(gè)單元格。': Exit Sub
    Set rng2 = Intersect(rng2.Parent.UsedRange, rng2)
    If Not rng2 Is Nothing Then arr2 = rng2.Value
    For i = 2 To UBound(arr1) '扣除標(biāo)題行
        If Len(arr1(i, 1)) Then
            d(''' & arr1(i, 1)) = '不存在'
            '將數(shù)據(jù)統(tǒng)一強(qiáng)制轉(zhuǎn)換為字符串格式
            '數(shù)據(jù)裝入字典，先統(tǒng)一設(shè)置item為不存在
        End If
    Next
    If UBound(arr1) > UBound(arr2) Then
    '計(jì)算兩列最大行數(shù)
        m = UBound(arr1)
    Else
        m = UBound(arr2)
    End If
    ReDim brr(0 To m, 1 To 3)
    '結(jié)果數(shù)組
    '第一列放AB均存在的數(shù)據(jù)
    '第二列放A有B沒有的數(shù)據(jù)
    '第三列放B有A沒有的數(shù)據(jù)
    For i = 2 To UBound(arr2)
        If Len(arr2(i, 1)) Then
            strTemp = ''' & arr2(i, 1)
            If d.exists(strTemp) Then '如果A有B也有
                n1 = n1 + 1
                brr(n1, 1) = strTemp
                d(strTemp) = '存在'
                '將AB均有的數(shù)據(jù)item修改為存在
            Else '如果B有A沒有
                n3 = n3 + 1
                brr(n3, 3) = strTemp
            End If
        End If
    Next
    kr = d.keys
    For i = 0 To UBound(kr)
        If d(kr(i)) = '不存在' Then '如果A有B沒有
            n2 = n2 + 1
            brr(n2, 2) = kr(i)
        End If
    Next
    Err.Clear
    Set rng = Application.InputBox('請(qǐng)選擇放置查詢結(jié)果的單元格，例如C1', Type:=8)
    rng.Parent.Select
    rng.Select
    If Err.Number = 0 Then
        brr(0, 1) = '兩列均存在的數(shù)據(jù)有' & n1 & '條'
        brr(0, 2) = 'A有B沒有的數(shù)據(jù)有' & n2 & '條'
        brr(0, 3) = 'B有A沒有的數(shù)據(jù)有' & n3 & '條'
        With rng(1).Resize(UBound(brr) + 1, 3)
            .ClearContents '打掃房間
            .NumberFormatLocal = '@'
            '設(shè)置文本格式，防止文本數(shù)值變形
            .Value = brr
        End With
        MsgBox '核對(duì)完成。' & vbLf & brr(0, 1) & vbLf & brr(0, 2) & vbLf & brr(0, 3)
    End If
    Set d = Nothing
    Set rng = Nothing
    Set rng1 = Nothing
    Set rng2 = Nothing
    Erase arr1: Erase arr2: Erase brr
End Sub