江苏龙网

  1. 首页 > 人文 > >

科技大本营|EXCEL用VBA代码查询两列数据差异

Excel之家ExcelHome以下文章来源于VBA编程学习与实践 ， 作者EH看见星光我们今天和大家分享的内容是如何用VBA代码查询两列数据差异 。
打个响指 ， 举个栗子 。
查询结果如下图所示 。
代码如下：
SubCheckTwoClnData()
DimdAsObject
【科技大本营|EXCEL用VBA代码查询两列数据差异】DimiAsLong,n1AsLong,n2AsLong,n3AsLong,mAsLong
DimstrTempAsString
Dimarr1AsVariant,arr2AsVariant,brrAsVariant,krAsVariant
Dimrng1AsRange,rng2AsRange,rngAsRange
Setd=CreateObject("scripting.dictionary")
OnErrorResumeNext
Setrng1=Application.InputBox("请选择需要核对差异的第一列数据",Type:=8)
'用户选取第一列数据
Ifrng1.Columns.Count>1ThenMsgBox"请选择单列数据 。 ":ExitSub
Ifrng1.Rows.Count=1ThenMsgBox"不能选择单个单元格 。 ":ExitSub
Setrng1=Intersect(rng1.Parent.UsedRange,rng1)
'防止用户选取整列造成运算量虚大效率低下
IfNotrng1IsNothingThenarr1=rng1.Value
'将第一列数据装入arr1
Setrng2=Application.InputBox("请选择需要核对差异的第二列数据",Type:=8)
'用户选取第二列数据
Ifrng2.Columns.Count>1ThenMsgBox"请选择单列数据 。 ":ExitSub
Ifrng2.Rows.Count=1ThenMsgBox"不能选择单个单元格 。 ":ExitSub
Setrng2=Intersect(rng2.Parent.UsedRange,rng2)
IfNotrng2IsNothingThenarr2=rng2.Value
Fori=2ToUBound(arr1)'扣除标题行
IfLen(arr1(i,1))Then
d("'"&arr1(i,1))="不存在"
'将数据统一强制转换为字符串格式
'数据装入字典 ， 先统一设置item为不存在
EndIf
Next
IfUBound(arr1)>UBound(arr2)Then
'计算两列最大行数
m=UBound(arr1)
Else
m=UBound(arr2)
EndIf
ReDimbrr(0Tom,1To3)
'结果数组
'第一列放AB均存在的数据
'第二列放A有B没有的数据
'第三列放B有A没有的数据
Fori=2ToUBound(arr2)
IfLen(arr2(i,1))Then
strTemp="'"&arr2(i,1)
Ifd.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
EndIf
EndIf
Next
kr=d.keys
Fori=0ToUBound(kr)
Ifd(kr(i))="不存在"Then'如果A有B没有
n2=n2+1
brr(n2,2)=kr(i)
EndIf
Next
Err.Clear
Setrng=Application.InputBox("请选择放置查询结果的单元格 ， 例如C1",Type:=8)
rng.Parent.Select
rng.Select
IfErr.Number=0Then
brr(0,1)="两列均存在的数据有"&n1&"条"
brr(0,2)="A有B没有的数据有"&n2&"条"
brr(0,3)="B有A没有的数据有"&n3&"条"
Withrng(1).Resize(UBound(brr)+1,3)
.ClearContents'打扫房间
.NumberFormatLocal="@"
'设置文本格式 ， 防止文本数值变形


推荐阅读


上一篇：汪晋朵|手机商们打响联名车轮站，营销观察丨小米坐在奔驰里笑

下一篇：酷酷玩游记|B站天价签约费回本？冯提莫出海再创直播圈纪录！网友：真的酸了