愛就一個字，我只說一次……

北京市第三交通委提醒您：代碼千萬條，注釋第一條，命名不規范，修訂兩行淚……

咳，給大家拜晚年了，再提前祝大家元宵快樂……

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

照例打個響指，舉個栗子。

如上圖所示，查詢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)) = "不存在"
??????????? '將數據統一強制轉換為字符串格式
??????????? '數據裝入字典，先統一設置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統一設置為“不存在”，然后判斷第二列的數據是否在字典中存在，如果存在，則將條目對應的item修改為“存在”，最后遍歷字典，查詢item仍然為“不存在”的數據。

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

3，代碼無視空格，不區分文本值和數值。例如'123等同于123。

4，還一個什么問題，我突然忘記了，最近老是發生提筆忘字、騎驢找唱本之類的傻事，唉。

示例文件下載戳文末閱讀原文

揮手再見說晚安~

總結

以上是生活随笔為你收集整理的查询时拼接两列数据_如何用VBA代码查询两列数据差异？的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。