求助：两张表对比找差异

rongguo52013

要求已写在表“说明”中。
复件 复件 料表比对模板.rar (15 KB, 下载次数: 174)

2011-9-27 08:43 上传

点击文件名下载附件

蓝桥玄霜

1. Sub yy()
   
2. Dim Arr, i&, xd%, aa, bb
   
3. Dim d, m&, n&, j&, Arr2, x$, y$, z$
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Application.ScreenUpdating = False
   
6. Sheet3.Activate
   
7. [a2:i2000].ClearContents
   
8. Arr = Sheet1.[a1].CurrentRegion
   
9. Arr2 = Sheet2.[a1].CurrentRegion
   
10. For i = 2 To UBound(Arr)
    
11.     x = Arr(i, 5)
    
12.     d(x) = d(x) & i & ","
    
13. Next
    
14. m = 1
    
15. For i = 2 To UBound(Arr2)
    
16.     x = Arr2(i, 5): xd = 0
    
17.     If d.exists(x) Then
    
18.         y = Arr2(i, 1) & "|" & Arr2(i, 2) & "|" & Arr2(i, 3)
    
19.         If d(x) = "" Then GoTo 50
    
20.         bb = Left(d(x), Len(d(x)) - 1)
    
21.         If InStr(bb, ",") Then
    
22.         aa = Split(bb, ",")
    
23.         For j = 0 To UBound(aa)
    
24.             z = Arr(aa(j), 1) & "|" & Arr(aa(j), 2) & "|" & Arr(aa(j), 3)
    
25.             If z = y Then xd = 1
    
26.         Next
    
27.             If xd = 0 Then
    
28.                 m = m + 1
    
29.                 Cells(m, 5).Resize(1, 3) = Split(y, "|")
    
30.                 Cells(m, 8) = x
    
31.             End If
    
32.         Else
    
33.             z = Arr(bb, 1) & "|" & Arr(bb, 2) & "|" & Arr(bb, 3)
    
34.             If z <> y Then
    
35.                 m = m + 1
    
36.                 Cells(m, 5).Resize(1, 3) = Split(y, "|")
    
37.                 Cells(m, 8) = x
    
38.             End If
    
39.         End If
    
40.     End If
    
41. 50:
    
42. Next
    
43. d.RemoveAll
    
44. For i = 2 To UBound(Arr2)
    
45.     x = Arr2(i, 5)
    
46.     d(x) = d(x) & i & ","
    
47. Next
    
48. n = 1
    
49. For i = 2 To UBound(Arr)
    
50.     x = Arr(i, 5): xd = 0
    
51.     If d.exists(x) Then
    
52.         y = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
    
53.         If d(x) = "" Then GoTo 100
    
54.         bb = Left(d(x), Len(d(x)) - 1)
    
55.         If InStr(bb, ",") Then
    
56.         aa = Split(bb, ",")
    
57.         For j = 0 To UBound(aa)
    
58.             z = Arr2(aa(j), 1) & "|" & Arr2(aa(j), 2) & "|" & Arr2(aa(j), 3)
    
59.             If z <> y Then xd = 1
    
60.         Next
    
61.             If xd = 0 Then
    
62.                 n = n + 1
    
63.                 Cells(n, 1).Resize(1, 3) = Split(z, "|")
    
64.                 Cells(n, 4) = x
    
65.             End If
    
66.         Else
    
67.             z = Arr2(bb, 1) & "|" & Arr2(bb, 2) & "|" & Arr2(bb, 3)
    
68.             If z <> y Then
    
69.                 n = n + 1
    
70.                 Cells(n, 1).Resize(1, 3) = Split(y, "|")
    
71.                 Cells(n, 4) = x
    
72.             End If
    
73.         End If
    
74.     End If
    
75. 100:
    
76. Next
    
77. Application.ScreenUpdating = True
    
78. Set d = Nothing
    
79. End Sub
    

复制代码

byhdch

看看，学习学习......