vba代码-如何用VBA代码查询两列数据差异？

今天和大家分享的内容是如何用VBA代码查询两列数据差异？

照例打个响指，举个栗子。

如上图所示，查询A列和C列的数据vba代码，提取出相同值、A列存在C列不存在的值、A列不存在C列存在的值……

查询结果如下图所示。

当然，这事儿并不是一定得用VBA，函数和Power Query都可以的。但我们是VBA公众号嘛，所以还是讲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。结果数组的行数原本是未知的，但最大行不会超过两个数据源行数的合计值；列数是已知的vba代码，有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行代码弹窗告知用户相同项、两表独有项的数目。

……

下载案例模版，点击【运行】按钮，即可快速查看两列数据异同项，动手试一下吧▼

百度网盘▼

提取码: n2xc

大师兄永久会员

收藏 海报 链接