★工作表之间多列数据对比★

LangQueS

gzy001 发表于 2012-5-3 12:36
狼版你好，这个贴子做比对是挺好的，能不能做一个灵活的，让所有的人都能自己选择列数，比如你现在对比的是 ...

代码中包含灵活的设置。以下是代码前面的内容：

x = "表1"   '工作表1名称
y = "表2"   '工作表2名称
zz = 4    '需要对比的列数

这个代码使用率不高，可以在代码中灵活设置就可以了。

轻风清

这个真的很实用

totoby

无论如何也要学习一下~~~

gzy001

狼版，请看附件，不知能否实现，如能实现，这对要做比对来说那方便多了。辛苦了，谢谢。

gzy001

LangQueS 发表于 2012-5-3 12:44
代码中包含灵活的设置。以下是代码前面的内容：

x = "表1"   '工作表1名称

版主，能否看一下上面的附件，能否做成，谢谢。

LangQueS

gzy001 发表于 2012-5-5 16:09
版主，能否看一下上面的附件，能否做成，谢谢。

你的想法是好的，由于这个问题通用性不强，不是经常用到，实际引用时，只要将需要对比的几列放在表格的前面就可以了，不必制作复杂的代码。

gzy001

LangQueS 发表于 2012-5-5 17:28
你的想法是好的，由于这个问题通用性不强，不是经常用到，实际引用时，只要将需要对比的几列放在表格的前 ...

版主你好，一般来说，要比对的数据都是对方发过来的数据跟我们自己数据做比对，找出其中的错误所在，如把要比对的列从中又折出来的话，比对完了又不知是那个位置了，我现在做的比对是最原始的方法，一一做对比，在网上找不到适合我的，如我提的方案能实现的话，起码对我的帮助就大了，因我每月都要对账，又没法把它折出来对比，不折又对不了，所以烦请版主能否达到我的要求呢？谢谢了。

LangQueS

gzy001 发表于 2012-5-6 09:46
版主你好，一般来说，要比对的数据都是对方发过来的数据跟我们自己数据做比对，找出其中的错误所在，如把 ...

比对的列从中不用“折出来”，将要比对的几列放到前面就可以了，不会影响对应关系。

gzy001

LangQueS 发表于 2012-5-6 09:50
比对的列从中不用“折出来”，将要比对的几列放到前面就可以了，不会影响对应关系。

谢谢版主，那能不能把比对完有错的提取出来吗？如安我上面附件的想法是否不好实现，还是做起来特别的麻烦。多谢。

蓝桥玄霜

1. Sub yy()
   
2. Dim Arr, i&, Myr&, Myc%, Arr2, Arr3, col%
   
3. Dim d, k, t, m&, n1&, n2&, j&, zm$
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Application.ScreenUpdating = False
   
6. Sheet3.Activate
   
7. [a6:s500].Clear
   
8. zm = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   
9. Myc = [iv2].End(xlToLeft).Column
   
10. Arr3 = Range("a2").Resize(1, Myc)
    
11. Arr = Sheet1.[a1].CurrentRegion
    
12. For i = 2 To UBound(Arr)
    
13.     If Arr(i, 1) <> "" Then d(Arr(i, 1)) = i
    
14. Next
    
15. Arr2 = Sheet2.[a1].CurrentRegion
    
16. n1 = 5: n2 = 5
    
17.     For i = 2 To UBound(Arr2)
    
18.         If d.exists(Arr2(i, 1)) Then
    
19.             m = d(Arr2(i, 1))
    
20.             For j = 1 To UBound(Arr3, 2)
    
21.                 col = InStr(zm, Arr3(1, j))
    
22.                 If Arr2(m, col) <> Arr(m, col) Then
    
23.                     n1 = n1 + 1
    
24.                     Cells(n1, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, m, 0)
    
25.                     n2 = n2 + 1
    
26.                     Cells(n2, 11).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, i, 0)
    
27.                 End If
    
28.             Next
    
29.         ElseIf Arr2(i, 1) <> "" Then
    
30.             n2 = n2 + 1
    
31.             Cells(n2, 11).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, i, 0)
    
32.         End If
    
33.     Next
    
34.     [a6].Resize(n1 - 5, 9).Borders.LineStyle = 1
    
35.     [k6].Resize(n2 - 5, 9).Borders.LineStyle = 1
    
36.     Set d = Nothing
    
37. Application.ScreenUpdating = True
    
38. End Sub
    

复制代码