ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
易厚学堂-专业的职场技能充电站 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 ExcelHome出品 - VBA代码宝免费下载 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 191|回复: 10

[求助] VBA对比找出两表差异部分求助大佬!鲜花奉上!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-11-8 11:20 | 显示全部楼层 |阅读模式
本来打算帮助别人解答的(此贴http://club.excelhome.net/thread-1444775-1-1.html),没想到遇到坎了,脑阔痛....哈哈
要求如下:通过VBA实现两表数据对比,找出差异项(判断依据:ABC某行3列完全一致为相同,有一个不一样即为不一样!),填入对比结果那里,结果已经模拟出来了,恳请大神看下!

表1数据

表1数据

表2数据

表2数据

对比结果

对比结果

对比工具.rar

25.05 KB, 下载次数: 9

文件

TA的精华主题

TA的得分主题

发表于 2018-11-8 11:31 | 显示全部楼层
看不懂模拟结果,意思是把两个表不一致的都全部罗列出来?

TA的精华主题

TA的得分主题

发表于 2018-11-8 11:42 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-11-8 11:55 | 显示全部楼层
onthetrip 发表于 2018-11-8 11:31
看不懂模拟结果,意思是把两个表不一致的都全部罗列出来?

是的,找出差异项

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-11-8 11:56 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-11-8 12:02 来自手机 | 显示全部楼层
约定的童话 发表于 2018-11-8 11:56
字典还没学会,写了一段报错N多.....

那就放弃吧,这个问题字典是首选

TA的精华主题

TA的得分主题

发表于 2018-11-8 12:41 | 显示全部楼层
好像有点啰嗦,不过也是字典基本用法

1108.rar

27.07 KB, 下载次数: 18

评分

参与人数 1鲜花 +2 收起 理由
约定的童话 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-11-8 13:22 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-11-8 13:23 | 显示全部楼层
  1. Private Sub Compare()
  2. Dim aApply, aCheck, aResult()
  3. Dim DicApply As Object, DicCheck As Object
  4. Dim sCombine As String
  5. Dim dKEY
  6. Dim i&, j&, iCount&
  7. aApply = Worksheets("申报表").[a1].CurrentRegion.Value
  8. aCheck = Worksheets("登记表").[a1].CurrentRegion.Value
  9. Set DicApply = CreateObject("scripting.dictionary")
  10. Set DicCheck = CreateObject("scripting.dictionary")
  11. For i = 2 To UBound(aApply)
  12.     sCombine = aApply(i, 1) & "@" & aApply(i, 2) & "@" & aApply(i, 3)
  13.     DicApply(sCombine) = i
  14. Next
  15. For i = 2 To UBound(aCheck)
  16.     sCombine = aCheck(i, 1) & "@" & aCheck(i, 2) & "@" & aCheck(i, 3)
  17.     DicCheck(sCombine) = i
  18. Next
  19. ReDim aResult(1 To UBound(aApply), 1 To 3)
  20. For Each dKEY In DicApply
  21.     If Not DicCheck.exists(dKEY) Then
  22.         iCount = iCount + 1
  23.         For j = 1 To 3
  24.             aResult(iCount, j) = aApply(DicApply(dKEY), j)
  25.         Next
  26.     Else
  27.         DicCheck.Remove dKEY
  28.     End If
  29. Next
  30. [a4].Resize(iCount, 3) = aResult
  31. ReDim aResult(1 To UBound(aCheck), 1 To 3)
  32. iCount = 0
  33. For Each dKEY In DicCheck
  34.     iCount = iCount + 1
  35.     For j = 1 To 3
  36.         aResult(iCount, j) = aCheck(DicCheck(dKEY), j)
  37.     Next
  38. Next
  39. [d4].Resize(iCount, 3) = aResult
  40. DicApply.RemoveAll: Set DicApply = Nothing
  41. DicCheck.RemoveAll: Set DicCheck = Nothing
  42. End Sub
复制代码

评分

参与人数 1鲜花 +1 收起 理由
约定的童话 + 1 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-11-8 13:31 | 显示全部楼层
参考测试附件:

找差异.rar

23.64 KB, 下载次数: 12

评分

参与人数 1鲜花 +2 收起 理由
约定的童话 + 2 优秀作品

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2018-11-15 20:17 , Processed in 0.132412 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表