register313

¦^´_ 1# XDshining

1. Sub aa()
   
2. Dim Ar() As String
   
3. Set d = CreateObject("scripting.dictionary")
   
4. With Sheet1
   
5.   For Each A In .Range(.[A2], .[A2].End(xlDown))
   
6.     d.Add A.Value, A.Value
   
7.   Next
   
8. End With
   
9. With Sheet2
   
10.   C = 0
    
11.   For Each A In .Range(.[A2], .[A2].End(xlDown))
    
12.     If d.exists(A.Value) Then
    
13.        C = C + 1
    
14.        ReDim Preserve Ar(1 To 2, 1 To C)
    
15.        Ar(1, C) = A
    
16.        Ar(2, C) = A.Offset(0, 1)
    
17.     End If
    
18.   Next
    
19. End With
    
20. Sheet3.Rows("2:65536") = ""
    
21. Sheet3.[A2].Resize(C, 2) = Application.Transpose(Ar)
    
22. End Sub

½Æ»s¥N½X