龙空技术网

用VBA代码查询两列数据差异

Excel之家 1395

前言:

今天大家对“vba字符串对比”大体比较关怀,小伙伴们都需要分析一些“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 brrEnd Sub

代码运行动画:

小贴士:

1,代码使用了字典对象,首先将第一列的数据装入字典,并将item统一设置为“不存在”,然后判断第二列的数据是否在字典中存在,如果存在,则将条目对应的item修改为“存在”,最后遍历字典,查询item仍然为“不存在”的数据。

2,代码允许用户选取整列数据,使用了Intersect方法避免运算量虚大效率低下的问题,但不允许用户选取多列或单个单元格。

3,代码无视空格,不区分文本值和数值。

图文作者:看见星光

标签: #vba字符串对比 #vba 字符串对比 #vba字符串对比函数 #vba字符串对比函数怎么写 #vba数据比对怎么写