Hsieh

¦^´_ 1# john2006168

1. Sub Ex()
   
2. Dim Ar(), Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. With Sheet1
   
7. For Each a In .Range(.[A2], .[A65536].End(xlUp))
   
8.    d(a.Value) = a.Value
   
9.    d2(a.Value) = a.Value
   
10. Next
    
11. End With
    
12. With Sheet2
    
13. For Each a In .Range(.[A2], .[A65536].End(xlUp))
    
14.    d1(a.Value) = a.Value
    
15.    d2(a.Value) = a.Value
    
16. Next
    
17. End With
    
18. ReDim Preserve Ar(s): Ar(s) = "¬Û¦PName": s = s + 1
    
19. ReDim Preserve Ay(k): Ay(k) = "¤£¦PName": k = k + 1
    
20. For Each ky In d2.keys
    
21.   If d.exists(ky) = True And d1.exists(ky) = True Then
    
22.   ReDim Preserve Ar(s) '¬Û¦P
    
23.   Ar(s) = ky
    
24.   s = s + 1
    
25.   Else
    
26.   ReDim Preserve Ay(k) '¤£¦P
    
27.   Ay(k) = ky
    
28.   k = k + 1
    
29.   End If
    
30. Next
    
31. With Sheet3
    
32. .Cells = ""
    
33. .[A1].Resize(s, 1) = Application.Transpose(Ar)
    
34. .[B1].Resize(k, 1) = Application.Transpose(Ay)
    
35. End With
    
36. End Sub

½Æ»s¥N½X