01.09 用VBA代碼查詢兩列數據差異

今天和大家分享的內容是如何用VBA代碼查詢兩列數據差異。

打個響指，舉個栗子。

如上圖所示，查詢A列和C列的數據，提取出相同值、A列存在C列不存在的值、A列不存在C列存在的值……

查詢結果如下圖所示。

當然，這事兒並不是一定得用VBA，函數和Power Query都可以的。但我們是VBA公眾號嘛，所以還是講VBA的方法……

代碼如下

<code>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)) = "不存在"
 '將數據統一強制轉換為字符串格式 

 '數據裝入字典，先統一設置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/<code>

代碼運行動畫：

小貼士：

1，代碼使用了字典對象，首先將第一列的數據裝入字典，並將item統一設置為“不存在”，然後判斷第二列的數據是否在字典中存在，如果存在，則將條目對應的item修改為“存在”，最後遍歷字典，查詢item仍然為“不存在”的數據。

2，代碼允許用戶選取整列數據，使用了Intersect方法避免運算量虛大效率低下的問題，但不允許用戶選取多列或單個單元格。

3，代碼無視空格，不區分文本值和數值。

閱讀更多 Excel之家 的文章

關鍵字: 查詢 代碼 鏡音雙子