Hsieh

¦^´_ 1# john2006168

1. Sub Ex()
   
2. Dim Ar()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set dc1 = CreateObject("Scripting.Dictionary")
   
5. With Sheet1
   
6.    For Each a In .Range(.[A2], .[A65536].End(xlUp))
   
7.        d(a.Value) = a.Offset(, 1)
   
8.    Next
   
9.    For Each a In .Range(.[D2], .[D65536].End(xlUp))
   
10.        dc1(a.Value) = a.Offset(, 1)
    
11.    Next
    
12. End With
    
13. Sheet2.Columns("A:E") = ""
    
14.    For Each ky In d.keys
    
15.       If d(ky) <> dc1(ky) And d(ky) <> "" Then
    
16.          ReDim Preserve Ar(s)
    
17.          Ar(s) = Array(ky, d(ky))
    
18.          s = s + 1
    
19.       End If
    
20.     Next
    
21.     If s > 0 Then Sheet2.[A1].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
    
22.     s = 0: Erase Ar
    
23.    For Each ky In dc1.keys
    
24.       If d(ky) <> dc1(ky) And dc1(ky) <> "" Then
    
25.          ReDim Preserve Ar(s)
    
26.          Ar(s) = Array(ky, dc1(ky))
    
27.          s = s + 1
    
28.       End If
    
29.     Next
    
30.     If s > 0 Then Sheet2.[D1].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
    
31. End Sub

½Æ»s¥N½X