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

gzy001

蓝桥玄霜 发表于 2012-5-6 20:54
你的这个附件里面有results病毒！

重发了个附件。帮去看一下。

gzy001

大家一起来多出出主意，能否把这个比对做的更完美，让这个比对称的上是完美比对。

gzy001

在蓝版的更改后，目前的比对对很多人来说应该是很方便了，再等待蓝版再进一步优化，来实现重复值对比。在此谢谢蓝版。

gzy001

蓝桥玄霜 发表于 2012-5-7 08:15
26楼的代码只解决大小写和单列比对的问题。

蓝版 ，这个功能还能否实现，还有一个好象位置不对，比对时也会出现错误现象，谢谢，等你佳音。

蓝桥玄霜

1. Sub yy()
   
2. Dim Arr, i&, Myr&, Myc%, Arr2, Arr3, col, x$
   
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. Arr2 = Sheet2.[a1].CurrentRegion
    
13. ReDim col(1 To UBound(Arr3, 2))
    
14. For j = 1 To UBound(Arr3, 2)
    
15.     col(j) = InStr(zm, UCase(Arr3(1, j)))
    
16. Next
    
17. n1 = 5: n2 = 5
    
18. For i = 2 To UBound(Arr)
    
19.     If Arr(i, 1) <> "" Then
    
20.         x = Arr(i, 1)
    
21.         For j = 1 To UBound(col)
    
22.             x = x & "," & Arr(i, col(j))
    
23.         Next
    
24.         d(x) = i
    
25.     End If
    
26. Next
    
27. 
    
28. For i = 2 To UBound(Arr2)
    
29.     If Arr2(i, 1) <> "" Then
    
30.         x = Arr2(i, 1)
    
31.         For j = 1 To UBound(col)
    
32.             x = x & "," & Arr2(i, col(j))
    
33.         Next
    
34.         m = d(x)
    
35.         If m = 0 Then
    
36.             n2 = n2 + 1
    
37.             Cells(n2, 11).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, i, 0)
    
38.         End If
    
39.     End If
    
40. Next
    
41. d.RemoveAll
    
42. For i = 2 To UBound(Arr2)
    
43.     If Arr2(i, 1) <> "" Then
    
44.         x = Arr2(i, 1)
    
45.         For j = 1 To UBound(col)
    
46.             x = x & "," & Arr2(i, col(j))
    
47.         Next
    
48.         d(x) = i
    
49.     End If
    
50. Next
    
51. 
    
52. For i = 2 To UBound(Arr)
    
53.     If Arr(i, 1) <> "" Then
    
54.         x = Arr(i, 1)
    
55.         For j = 1 To UBound(col)
    
56.             x = x & "," & Arr(i, col(j))
    
57.         Next
    
58.         m = d(x)
    
59.         If m = 0 Then
    
60.             n1 = n1 + 1
    
61.             Cells(n1, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, i, 0)
    
62.         End If
    
63.     End If
    
64. Next
    
65.     If n1 <> 5 Then [a6].Resize(n1 - 5, 9).Borders.LineStyle = 1
    
66.     If n2 <> 5 Then [k6].Resize(n2 - 5, 9).Borders.LineStyle = 1
    
67.     Set d = Nothing
    
68. Application.ScreenUpdating = True
    
69. End Sub
    

复制代码

蓝桥玄霜

请见附件。

gzy001

蓝桥玄霜 发表于 2012-5-9 11:04
请见附件。

蓝版，太谢谢了，这个我去实际就用一下，我刚试了一下，如要用单列作比对，条件区域单列不能放在A列，也就是第一个，用单列比对结果还有那么一、二个没有消除了，不过这个已很好了，谢谢我用实际数据去测一下，我实际数据有10列，不知会不会出错。多谢。

gzy001

不知错在那，数据一加进去，结果不对，不知错那了，篮版请看附件，

gzy001

蓝桥玄霜 发表于 2012-5-9 11:04
请见附件。

蓝版，有时间帮我看 一下，谢谢。

蓝桥玄霜

有什么不对的？除了D、E、F列外还有A列是必要条件。