如何用VBA代码查询两列数据差异?
Sub CheckDataDiff() Dim d As Object Dim aData1, aData2, aRes, aKeys Dim strKey As String, strMsg As String Dim i As Long, k As Long Dim intSame As Long, intShtA As Long, intShtB As Long Set d = CreateObject('scripting.dictionary') '后期绑定字典 With Worksheets('表1') '表1 A列数据存入数组 aData1 = .Range('a1:a' & .Cells(Rows.Count, 1).End(xlUp).Row) End With With Worksheets('表2') '表2 A列数据存入数组 aData2 = .Range('a1:a' & .Cells(Rows.Count, 1).End(xlUp).Row) End With For i = 2 To UBound(aData1) '遍历表1数据存入字典 strKey = aData1(i, 1) d(strKey) = '表1' '将来源作为item Next ReDim aRes(1 To UBound(aData1) + UBound(aData2), 1 To 3) '定义结果数组大小 For i = 2 To UBound(aData2) '遍历表2数据 strKey = aData2(i, 1) If d.exists(strKey) Then '如果存在关键字…… If d(strKey) = '表1' Then '如果该关键字属于表1,这层判断是为了避免表2存在重复值 intSame = intSame + 1 '累加相同个数 aRes(intSame, 1) = strKey '存入结果数组第1列 d(strKey) = '相同' '将关键字对应的item修改为相同 End If Else '如果字典不存在该关键字,说明是表2独有 intShtB = intShtB + 1 '累加B表独有个数 aRes(intShtB, 3) = strKey '存入结果数组第3列 d(strKey) = '表2' '存入字典,item为来源表2 End If Next aKeys = d.keys '字典的keys集合 For i = 0 To UBound(aKeys) '遍历字典剔除tiem相同的即为A表独有值 strKey = aKeys(i) If d(strKey) = '表1' Then intShtA = intShtA + 1 '累加A表独有个数 aRes(intShtA, 2) = strKey '存入结果数组第2列 End If Next If k < intSame Then k = intSame If k < intShtA Then k = intShtA If k < intShtB Then k = intShtB Worksheets('结果').Select Range('a:e').ClearContents Range('a1').Resize(UBound(aData1), 1) = aData1 'A列放表1数据 Range('b1').Resize(UBound(aData2), 1) = aData2 'B列放表2数据 Range('a1:e1') = Array('A表数据', 'B表数据', '相同项', 'A表独有', 'B表独有') Range('c2').Resize(k, UBound(aRes, 2)) = aRes '结果数组数据 strMsg = '两表相同项:' & intSame & vbCrLf _ & 'A表独有项:' & intShtA & vbCrLf _ & 'B表独有项:' & intShtB MsgBox strMsg, , '公众号Excel星球' Set d = NothingEnd Sub
代码解析▼
第8行至第10行代码将表1 A列的数据存入数组aData1。
第11行至第13行代码将表2 A列的数据存入数组aData2。
第14行至第17行代码遍历aData1的数据,作为关键字存入字典,并将对应的item设置为来源表的名字'表1'。
第18行代码声明一个结果数组aRes。结果数组的行数原本是未知的,但最大行不会超过两个数据源行数的合计值;列数是已知的,有3列,第1列存放两表相同项,第2列存放A表独有项,第3列存放B表独有项。
第19至第32行代码遍历数组aData2。
第20行代码将aData2的数据赋值字符串变量strKey。
第21行代码判断字典中是否存在strKey。
如果存在,同时对应的item为表1,则说明该值属于两表相同项,存入结果数组第1列。
如果不存在,说明该值B表独有,则存入结果数组第3列,即B表独有项;同时将该值存入字典,item设置为'表2',避免表2存在重复值时,结果数组出现项目重复统计问题。
第33行至第40代码遍历字典的Key,如果Key对应的Item为'表1',则说明是表1独有项,存入结果数组第2列。
第41行至第43行代码通过比较运算,获取结果数组有效行的最大行数,赋值变量k。
第49行代码将结果数组的数据写入工作表单元格区域。
第50行和第51行代码弹窗告知用户相同项、两表独有项的数目。
……
下载案例模版,点击【运行】按钮,即可快速查看两列数据异同项,动手试一下吧▼
百度网盘▼
https://pan.baidu.com/s/1FyVdDFCAxQSQNc2pKkRRRw
赞 (0)