打個響指，舉個栗子。
如上圖所示，查詢A列和C列的數據，提取出相同值、A列存在C列不存在的值、A列不存在C列存在的值……
查詢結果如下圖所示。
當然，這事兒并不是一定得用VBA，函數和Power Query都可以的。但我們是VBA公眾號嘛，所以還是講VBA的方法……
代碼如下：
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('請選擇需要核對差異的第一列數據', Type:=8)
'用戶選取第一列數據
If rng1.Columns.Count > 1 Then MsgBox '請選擇單列數據。': Exit Sub
If rng1.Rows.Count = 1 Then MsgBox '不能選擇單個單元格。': Exit Sub
Set rng1 = Intersect(rng1.Parent.UsedRange, rng1)
'防止用戶選取整列造成運算量虛大效率低下
If Not rng1 Is Nothing Then arr1 = rng1.Value
'將第一列數據裝入arr1
Set rng2 = Application.InputBox('請選擇需要核對差異的第二列數據', Type:=8)
'用戶選取第二列數據
If rng2.Columns.Count > 1 Then MsgBox '請選擇單列數據。': Exit Sub
If rng2.Rows.Count = 1 Then MsgBox '不能選擇單個單元格。': Exit Sub
Set rng2 = Intersect(rng2.Parent.UsedRange, rng2)
If Not rng2 Is Nothing Then arr2 = rng2.Value
For i = 2 To UBound(arr1) '扣除標題行
If Len(arr1(i, 1)) Then
d(''' & arr1(i, 1)) = '不存在'
'將數據統(tǒng)一強制轉換為字符串格式
'數據裝入字典，先統(tǒng)一設置item為不存在
End If
Next
If UBound(arr1) > UBound(arr2) Then
'計算兩列最大行數
m = UBound(arr1)
Else
m = UBound(arr2)
End If
ReDim brr(0 To m, 1 To 3)
'結果數組
'第一列放AB均存在的數據
'第二列放A有B沒有的數據
'第三列放B有A沒有的數據
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均有的數據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('請選擇放置查詢結果的單元格，例如C1', Type:=8)
rng.Parent.Select
rng.Select
If Err.Number = 0 Then
brr(0, 1) = '兩列均存在的數據有' & n1 & '條'
brr(0, 2) = 'A有B沒有的數據有' & n2 & '條'
brr(0, 3) = 'B有A沒有的數據有' & n3 & '條'
With rng(1).Resize(UBound(brr) + 1, 3)
.ClearContents '打掃房間
.NumberFormatLocal = '@'
'設置文本格式，防止文本數值變形
.Value = brr
End With
MsgBox '核對完成。' & 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
代碼運行動畫：
小貼士：
1，代碼使用了字典對象，首先將第一列的數據裝入字典，并將item統(tǒng)一設置為“不存在”，然后判斷第二列的數據是否在字典中存在，如果存在，則將條目對應的item修改為“存在”，最后遍歷字典，查詢item仍然為“不存在”的數據。
2，代碼允許用戶選取整列數據，使用了Intersect方法避免運算量虛大效率低下的問題，但不允許用戶選取多列或單個單元格。
3，代碼無視空格，不區(qū)分文本值和數值。
