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

蓝桥玄霜

请见附件。

gzy001

蓝桥玄霜 发表于 2012-5-6 14:55
请见附件。

谢谢蓝版，我去试一下。多谢。

gzy001

蓝桥玄霜 发表于 2012-5-6 14:55
请见附件。

蓝版，我试了一下，还真的好用了，不过条件区域的列的字母必须是大写的，能否把“ZM”的值设一下不用分大小写，别外一个不能用单列来作比对，否则出错，蓝版，你看能否再完美一下，谢谢。

gzy001

各位版主帮再看一下，在有重复值的数据中能否实现比对。谢谢，请见附件。

gzy001

蓝桥玄霜 发表于 2012-5-6 14:55
请见附件。

蓝版，帮看一下附件，有这几个问题，重复值、列数大小写、单列这几个比对有误，望请看一下，谢谢。

蓝桥玄霜

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.             If Myc > 1 Then
    
21.                 For j = 1 To UBound(Arr3, 2)
    
22.                     col = InStr(zm, UCase(Arr3(1, j)))
    
23.                     If Arr2(m, col) <> Arr(m, col) Then
    
24.                         n1 = n1 + 1
    
25.                         Cells(n1, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, m, 0)
    
26.                         n2 = n2 + 1
    
27.                         Cells(n2, 11).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, i, 0)
    
28.                     End If
    
29.                 Next
    
30.             Else
    
31.                 col = InStr(zm, UCase(Arr3))
    
32.                     If Arr2(m, col) <> Arr(m, col) Then
    
33.                         n1 = n1 + 1
    
34.                         Cells(n1, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, m, 0)
    
35.                         n2 = n2 + 1
    
36.                         Cells(n2, 11).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, i, 0)
    
37.                     End If
    
38.                
    
39.             End If
    
40.         ElseIf Arr2(i, 1) <> "" Then
    
41.             n2 = n2 + 1
    
42.             Cells(n2, 11).Resize(1, UBound(Arr2, 2)) = Application.Index(Arr2, i, 0)
    
43.         End If
    
44.     Next
    
45.     [a6].Resize(n1 - 5, 9).Borders.LineStyle = 1
    
46.     [k6].Resize(n2 - 5, 9).Borders.LineStyle = 1
    
47.     Set d = Nothing
    
48. Application.ScreenUpdating = True
    
49. End Sub
    

复制代码

蓝桥玄霜

gzy001 发表于 2012-5-6 18:54
各位版主帮再看一下，在有重复值的数据中能否实现比对。谢谢，请见附件。

你的这个附件里面有results病毒！

gzy001

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

昨天在本站下了一个文件，是不是这里面带的，怎么才能处理了，我用360没有测出来。还有这个代码还是不起效果。谢谢。

蓝桥玄霜

26楼的代码只解决大小写和单列比对的问题。

gzy001

这个应不带病毒了，请见附件。