设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › vba核对数据
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 5234|回复: 7

[已解决]vba核对数据

[复制链接]
发表于 2014-7-20 21:20 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
25学分
本帖最后由 excel白兔 于 2014-7-23 08:02 编辑

老师们帮助看看这个怎么弄呢 这个弄完了我这个东西基本就弄好了
最佳答案
月排行榜 / 总排行榜
yangyangzhifeng
2014-7-22 17:16
试试看
  1. Sub test()
  2.     Dim dic1, dic2, ar, i&, j&, st$, br(), n&, t
  3.     Set dic1 = CreateObject("scripting.dictionary")
  4.     Set dic2 = CreateObject("scripting.dictionary")
  5.     ar = Sheets("1").Range("a1").CurrentRegion
  6.     For i = 3 To UBound(ar)
  7.         For j = 6 To UBound(ar, 2)
  8.             If ar(i, j) > 0 Then
  9.                 st = ar(i, 2) & "|" & Val(ar(2, j))
  10.                 dic1(st) = ar(i, j)
  11.             End If
  12.         Next
  13.     Next
  14.     ar = Sheets("2").Range("a1").CurrentRegion
  15.     For i = 2 To UBound(ar)
  16.         If ar(i, 11) > 0 Then
  17.             st = ar(i, 5) & "|" & Val(ar(i, 10))
  18.             dic2(st) = ar(i, 11) & "|" & ar(i, 6)
  19.         End If
  20.     Next
  21.     ReDim br(1 To dic1.Count + dic2.Count, 1 To 4)
  22.     For Each t In dic2.keys    '遍历2表，如表1不存在该项或存在但价格不等就加入表3
  23.         If Not dic1.exists(t) Then
  24.             n = n + 1
  25.             br(n, 1) = Split(t, "|")(0)
  26.             br(n, 3) = Split(t, "|")(1)
  27.             br(n, 2) = Split(dic2(t), "|")(1)
  28.             br(n, 4) = "表2有表1无"
  29.         Else
  30.             If dic1(t) <> Val(dic2(t)) Then
  31.                 n = n + 1
  32.                 br(n, 1) = Split(t, "|")(0)
  33.                 br(n, 3) = Split(t, "|")(1)
  34.                 br(n, 2) = Split(dic2(t), "|")(1)
  35.                 br(n, 4) = "价格不等"
  36.             End If
  37.             dic1.Remove (t)    '两表都存在的项目移除以免结果重复
  38.         End If
  39.     Next
  40.     For Each t In dic1.keys    '表1中项目在表2不存在的
  41.         n = n + 1
  42.         br(n, 1) = Split(t, "|")(0)
  43.         br(n, 3) = Split(t, "|")(1)
  44.         br(n, 4) = "表1有表2无"
  45.     Next
  46.     If n > 0 Then
  47.         With Sheets("3")
  48.             .Range("a2:d" & Rows.Count).ClearContents
  49.             .Range("a2").Resize(n, 4) = br
  50.         End With
  51.     End If
  52. End Sub
复制代码

核对数据VAB.rar

102.05 KB, 下载次数: 29
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
发表于 2014-7-20 22:16 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
标注一下。有办法再回复。
回复

使用道具 举报

发表于 2014-7-20 22:41 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
两表本身的重复数据只记录最后一条（若价格不等，也只以最后一条的价格为准）
  1. Sub test()
  2.     Dim dic1, dic2, ar, i&, j&, st$, br(), n&, t
  3.     Set dic1 = CreateObject("scripting.dictionary")
  4.     Set dic2 = CreateObject("scripting.dictionary")
  5.     ar = Sheets("1").Range("a1").CurrentRegion
  6.     For i = 3 To UBound(ar)
  7.         For j = 6 To UBound(ar, 2)
  8.             If ar(i, j) > 0 Then
  9.                 st = ar(i, 2) & "|" & Val(ar(2, j))
  10.                 dic1(st) = ar(i, j)
  11.             End If
  12.         Next
  13.     Next
  14.     ar = Sheets("2").Range("a1").CurrentRegion
  15.     For i = 2 To UBound(ar)
  16.         If ar(i, 11) > 0 Then
  17.             st = ar(i, 5) & "|" & Val(ar(2, 10))
  18.             dic2(st) = ar(i, 11) & "|" & ar(i, 6)
  19.         End If
  20.     Next
  21.     ReDim br(1 To dic1.Count + dic2.Count, 1 To 3)
  22.     For Each t In dic2.keys    '遍历2表，如表1不存在该项或存在但价格不等就加入表3
  23.         If Not dic1.exists(t) Then
  24.             n = n + 1
  25.             br(n, 1) = Split(t, "|")(0)
  26.             br(n, 3) = Split(t, "|")(1)
  27.             br(n, 2) = Split(dic2(t), "|")(1)
  28.         Else
  29.             If dic1(t) <> Val(dic2(t)) Then
  30.                 n = n + 1
  31.                 br(n, 1) = Split(t, "|")(0)
  32.                 br(n, 3) = Split(t, "|")(1)
  33.                 br(n, 2) = Split(dic2(t), "|")(1)
  34.             End If
  35.             dic1.Remove (t) '两表都存在的项目移除以免结果重复
  36.         End If
  37.     Next
  38.     For Each t In dic1.keys    '表1中项目在表2不存在的
  39.         n = n + 1
  40.         br(n, 1) = Split(t, "|")(0)
  41.         br(n, 3) = Split(t, "|")(1)
  42.     Next
  43.     With Sheets("3")
  44.         .Range("a2:c" & Rows.Count).ClearContents
  45.         .Range("a2").Resize(n, 3) = br
  46.     End With
  47. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-7-21 08:15 | 显示全部楼层
yangyangzhifeng 发表于 2014-7-20 22:41
两表本身的重复数据只记录最后一条（若价格不等，也只以最后一条的价格为准）

老师辛苦了
是这样的我把老师的代码弄进去了但是结果不对呀
是这样的 1表和2表 核对的时候怎么把一样的都核对出来了呀？老师请看我那附件

核对数据VAB.rar

128.54 KB, 下载次数: 17
回复

使用道具 举报

发表于 2014-7-21 11:44 | 显示全部楼层
本帖最后由 yangyangzhifeng 于 2014-7-21 11:48 编辑
excel白兔 发表于 2014-7-21 08:15
老师辛苦了
是这样的我把老师的代码弄进去了但是结果不对呀
是这样的 1表和2表 核对的时候怎么把一样的 ...

一处忘改了，试试看
  1. Sub test()
  2.     Dim dic1, dic2, ar, i&, j&, st$, br(), n&, t
  3.     Set dic1 = CreateObject("scripting.dictionary")
  4.     Set dic2 = CreateObject("scripting.dictionary")
  5.     ar = Sheets("1").Range("a1").CurrentRegion
  6.     For i = 3 To UBound(ar)
  7.         For j = 6 To UBound(ar, 2)
  8.             If ar(i, j) > 0 Then
  9.                 st = ar(i, 2) & "|" & Val(ar(2, j))
  10.                 dic1(st) = ar(i, j)
  11.             End If
  12.         Next
  13.     Next
  14.     ar = Sheets("2").Range("a1").CurrentRegion
  15.     For i = 2 To UBound(ar)
  16.         If ar(i, 11) > 0 Then
  17.             st = ar(i, 5) & "|" & Val(ar(i, 10))
  18.             dic2(st) = ar(i, 11) & "|" & ar(i, 6)
  19.         End If
  20.     Next
  21.     ReDim br(1 To dic1.Count + dic2.Count, 1 To 3)
  22.     For Each t In dic2.keys    '遍历2表，如表1不存在该项或存在但价格不等就加入表3
  23.         If Not dic1.exists(t) Then
  24.             n = n + 1
  25.             br(n, 1) = Split(t, "|")(0)
  26.             br(n, 3) = Split(t, "|")(1)
  27.             br(n, 2) = Split(dic2(t), "|")(1)
  28.         Else
  29.             If dic1(t) <> Val(dic2(t)) Then
  30.                 n = n + 1
  31.                 br(n, 1) = Split(t, "|")(0)
  32.                 br(n, 3) = Split(t, "|")(1)
  33.                 br(n, 2) = Split(dic2(t), "|")(1)
  34.             End If
  35.             dic1.Remove (t) '两表都存在的项目移除以免结果重复
  36.         End If
  37.     Next
  38.     For Each t In dic1.keys    '表1中项目在表2不存在的
  39.         n = n + 1
  40.         br(n, 1) = Split(t, "|")(0)
  41.         br(n, 3) = Split(t, "|")(1)
  42.     Next
  43.     With Sheets("3")
  44.         .Range("a2:c" & Rows.Count).ClearContents
  45.         .Range("a2").Resize(n, 3) = br
  46.     End With
  47. End Sub
复制代码
回复

使用道具 举报

发表于 2014-7-22 00:01 | 显示全部楼层
表2分销渠道有19，表1却没有19。到底有多少分销渠道？
回复

使用道具 举报

 楼主| 发表于 2014-7-22 16:15 | 显示全部楼层
yangyangzhifeng 发表于 2014-7-21 11:44
一处忘改了，试试看

对的老师就是这样的
老师这个代码有2个问题想优化下
1老师能否在D列显示不一样的原因有3中可能      一 1表中有2表中无   二 2表中有1表中无 三 1表和2表价格不等   这3种情况
2就是如果没有不一样的代码运行中错误。
谢谢老师  （最近较忙没及时回复老师真是不好意思）
回复

使用道具 举报

发表于 2014-7-22 17:16 | 显示全部楼层    本楼为最佳答案   
试试看
  1. Sub test()
  2.     Dim dic1, dic2, ar, i&, j&, st$, br(), n&, t
  3.     Set dic1 = CreateObject("scripting.dictionary")
  4.     Set dic2 = CreateObject("scripting.dictionary")
  5.     ar = Sheets("1").Range("a1").CurrentRegion
  6.     For i = 3 To UBound(ar)
  7.         For j = 6 To UBound(ar, 2)
  8.             If ar(i, j) > 0 Then
  9.                 st = ar(i, 2) & "|" & Val(ar(2, j))
  10.                 dic1(st) = ar(i, j)
  11.             End If
  12.         Next
  13.     Next
  14.     ar = Sheets("2").Range("a1").CurrentRegion
  15.     For i = 2 To UBound(ar)
  16.         If ar(i, 11) > 0 Then
  17.             st = ar(i, 5) & "|" & Val(ar(i, 10))
  18.             dic2(st) = ar(i, 11) & "|" & ar(i, 6)
  19.         End If
  20.     Next
  21.     ReDim br(1 To dic1.Count + dic2.Count, 1 To 4)
  22.     For Each t In dic2.keys    '遍历2表，如表1不存在该项或存在但价格不等就加入表3
  23.         If Not dic1.exists(t) Then
  24.             n = n + 1
  25.             br(n, 1) = Split(t, "|")(0)
  26.             br(n, 3) = Split(t, "|")(1)
  27.             br(n, 2) = Split(dic2(t), "|")(1)
  28.             br(n, 4) = "表2有表1无"
  29.         Else
  30.             If dic1(t) <> Val(dic2(t)) Then
  31.                 n = n + 1
  32.                 br(n, 1) = Split(t, "|")(0)
  33.                 br(n, 3) = Split(t, "|")(1)
  34.                 br(n, 2) = Split(dic2(t), "|")(1)
  35.                 br(n, 4) = "价格不等"
  36.             End If
  37.             dic1.Remove (t)    '两表都存在的项目移除以免结果重复
  38.         End If
  39.     Next
  40.     For Each t In dic1.keys    '表1中项目在表2不存在的
  41.         n = n + 1
  42.         br(n, 1) = Split(t, "|")(0)
  43.         br(n, 3) = Split(t, "|")(1)
  44.         br(n, 4) = "表1有表2无"
  45.     Next
  46.     If n > 0 Then
  47.         With Sheets("3")
  48.             .Range("a2:d" & Rows.Count).ClearContents
  49.             .Range("a2").Resize(n, 4) = br
  50.         End With
  51.     End If
  52. End Sub
复制代码
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-5-23 11:05 , Processed in 0.287530 second(s), 8 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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