怎样使用VBA代码查询两列数据差异?
来源:网络收集 点击: 时间:2024-05-12首先在开发工具中打开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、本文系转载,版权归原作者所有,旨在传递信息,不代表看本站的观点和立场。
2、本站仅提供信息发布平台,不承担相关法律责任。
3、若侵犯您的版权或隐私,请联系本站管理员删除。
4、文章链接:http://www.1haoku.cn/art_747365.html