Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1940|回复: 5

[已解决]两表核对

[复制链接]
发表于 2014-6-27 11:30 | 显示全部楼层 |阅读模式
两表核对问题.rar (10.77 KB, 下载次数: 8)

相关帖子

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-6-27 12:33 | 显示全部楼层
  1. Sub test()
  2.     Dim arr, ar, d1 As Object, d2 As Object
  3.     Dim x%, y%, s1$, s2$, j%, maxr%
  4.     Set d1 = CreateObject("scripting.dictionary")
  5.     Set d2 = CreateObject("scripting.dictionary")
  6.     arr = Sheet1.UsedRange.Value
  7.     ar = Sheet2.UsedRange.Value
  8.     For x = 3 To UBound(arr)
  9.         For y = 3 To UBound(ar)
  10.             s1 = arr(x, 2) & arr(x, 6)
  11.             s2 = ar(y, 2) & ar(y, 6)
  12.             d1(s1) = 0: d2(s2) = 0
  13.             If s1 = s2 Then
  14.                 For j = 3 To 5
  15.                     If arr(x, j) <> ar(y, j) Then
  16.                         With Sheet2
  17.                             .Cells(y, j) = Sheet1.Cells(x, j)
  18.                             .Cells(y, j).Interior.ColorIndex = 5
  19.                             .Cells(y, "h") = "修改了数据!"
  20.                         End With
  21.                     End If
  22.                 Next
  23.             End If
  24.         Next y
  25.     Next x
  26.     For x = 3 To UBound(arr)
  27.         s1 = arr(x, 2) & arr(x, 6)
  28.         If Not d2.exists(s1) Then
  29.             With Sheet2
  30.                 maxr = .[a2].End(4).Row + 1
  31.                 Sheet1.Cells(x, 1).Resize(1, 7).Copy .Cells(maxr, 1)
  32.                 .Cells(maxr, "h") = "增加内容"
  33.                 .Cells(maxr, 1).Resize(1, 8).Interior.ColorIndex = 4
  34.             End With
  35.         End If
  36.     Next x
  37.     For y = 3 To UBound(ar)
  38.         s2 = ar(y, 2) & ar(y, 6)
  39.         If Not d1.exists(s2) Then
  40.             With Sheet2
  41.                 .Cells(y, 1).Resize(1, 8).Interior.ColorIndex = 3
  42.                 .Cells(y, "h") = "删除内容!"
  43.             End With
  44.         End If
  45.     Next y
  46. End Sub
复制代码

两表核对问题.rar

22.36 KB, 下载次数: 7

回复

使用道具 举报

 楼主| 发表于 2014-6-27 14:28 | 显示全部楼层
谢谢云影,结果很准确,能否在表二中只核对,就是当有相同关键字那一行,不修改数据,只标注.其余都一样.
生成表三,修改好数据,红色的直接删除,绿色的添加到最后行.关键字相同的按表一修改数据.即表三是一张准确表.
谢谢!
回复

使用道具 举报

发表于 2014-6-27 15:26 | 显示全部楼层    本楼为最佳答案   
两表核对问题.rar (24.35 KB, 下载次数: 33)
回复

使用道具 举报

 楼主| 发表于 2014-6-29 21:40 | 显示全部楼层
谢谢云影,正是想要的结果,谢谢!几天没有上网,回复晚了!
回复

使用道具 举报

发表于 2014-6-29 22:29 | 显示全部楼层
学习
回复

使用道具 举报

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

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 04:34 , Processed in 1.754127 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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