用VBA代码查询两列数据差异 vba对比两列找不同

今天和大家分享的内容是如何用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，代码无视空格，不区分文本值和数值。

图文作者：看见星光