对比两个表格中的数据，并标记不一致的数据

youchen339

最近老婆工作中遇到一个问题，有两个数据表格，每个有上万条记录，要来对比两个表格里的记录是否是一致的，用眼去一个个看，真心不是人干的事情哈，求助看老师们能不能帮帮我，如示例表中一样，在两个表中把不一样的数据标识出来呢，然后再交给人工去核对这些标识出的数据！

真心谢谢！！


示例.zip (12.89 KB, 下载次数: 173)

2015-4-10 11:26 上传

点击文件名下载附件

youchen339

论坛里转了好久没有找到办法，又网上去找了好些贴子，都没有找到能用的，还有号称能对比数据的软件，下下来用了一下，也不行，期待老师能够帮我解决这个大难题，谢谢！

gdw831001

还没有见过序号这一列是用人名当序号的，还要楼主要说明对比规则的

zongyj

如何对比，所有数据完全一致？？

zongyj

1. Sub db()
   
2.     Dim arr, brr, crr(), i, j, str
   
3.     Dim d As New Dictionary
   
4.     arr = Sheet1.Range("a2:h85")
   
5.     brr = Sheet2.Range("a2:h86")
   
6.     For i = 1 To UBound(arr)
   
7.         str = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4) & arr(i, 5) & arr(i, 6) & arr(i, 7) & arr(i, 8)
   
8.         If Not d.Exists(str) Then d.Add str, ""
   
9.     Next
   
10.     ReDim crr(1 To UBound(brr))
    
11.     For i = 1 To UBound(brr)
    
12.         str = brr(i, 1) & brr(i, 2) & brr(i, 3) & brr(i, 4) & brr(i, 5) & brr(i, 6) & brr(i, 7) & brr(i, 8)
    
13.         If d.Exists(str) Then
    
14.             crr(i) = ""
    
15.         Else
    
16.             crr(i) = "不一致"
    
17.         End If
    
18.     Next
    
19.     Sheet2.Range("i2:i86") = WorksheetFunction.Transpose(crr)
    
20. End Sub

复制代码

zongyj

不知是不是这个意思

youchen339

感谢，是这个意思，不过示例里只用表2对比了表1，在表2里做出了标记，我还须要做一个同样的操作，用表1去对比表2，在表1里也标记出来，就可以啦！！
再次感谢！！

youchen339

zongyj 发表于 2015-4-10 08:36
不知是不是这个意思

是的，最终结果要求两个表里面的数据要完全一致，把不一致的标记出来后，我们再人工核对最终数据哈！

第一列其实是班主任，呵呵，没有改过来，现在已经重新改了一下！示例已经重新上传了！

谢谢！

zongyj

简单点的方法就是arr ，brr互换两段代码试试，下午有时间的话整合成一段

zongyj

1. Option Explicit
   
2. 
   
3. Sub db()
   
4.     Dim arr, brr, crr(), i, j, str, drr
   
5.     Dim d As New Dictionary, d1 As New Dictionary
   
6.     arr = Sheet1.Range("a2:h85")
   
7.     brr = Sheet2.Range("a2:h86")
   
8.     For i = 1 To UBound(arr)
   
9.         str = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4) & arr(i, 5) & arr(i, 6) & arr(i, 7) & arr(i, 8)
   
10.         If Not d.Exists(str) Then d.Add str, ""
    
11.     Next
    
12.     For i = 1 To UBound(brr)
    
13.         str = brr(i, 1) & brr(i, 2) & brr(i, 3) & brr(i, 4) & brr(i, 5) & brr(i, 6) & brr(i, 7) & brr(i, 8)
    
14.         If Not d1.Exists(str) Then d1.Add str, ""
    
15.     Next
    
16.     ReDim drr(1 To UBound(arr))
    
17.     ReDim crr(1 To UBound(brr))
    
18.     For i = 1 To UBound(brr)
    
19.         str = brr(i, 1) & brr(i, 2) & brr(i, 3) & brr(i, 4) & brr(i, 5) & brr(i, 6) & brr(i, 7) & brr(i, 8)
    
20.         If d.Exists(str) Then
    
21.             crr(i) = ""
    
22.         Else
    
23.             crr(i) = "不一致"
    
24.         End If
    
25.     Next
    
26.     For i = 1 To UBound(arr)
    
27.         str = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4) & arr(i, 5) & arr(i, 6) & arr(i, 7) & arr(i, 8)
    
28.         If d1.Exists(str) Then
    
29.             drr(i) = ""
    
30.         Else
    
31.             drr(i) = "不一致"
    
32.         End If
    
33.     Next
    
34.     Sheet1.Range("i2:i85") = WorksheetFunction.Transpose(drr)
    
35.     Sheet2.Range("i2:i86") = WorksheetFunction.Transpose(crr)
    
36. End Sub
    

复制代码