Hsieh

¦^´_ 1# eric093

1. Sub ex()
   
2. Dim A As Range, Rng As Range, Ar(), s&
   
3. With Sheets("¦W³æ")
   
4.    For Each A In .Range(.[A2], .[A2].End(xlDown))
   
5.    With Sheets("¸ê®Æ¨Ó·½")
   
6.    Set Rng = .[A:A].Find(A, lookat:=xlWhole)
   
7.    If Not Rng Is Nothing Then
   
8.    ReDim Preserve Ar(s)
   
9.    Ar(s) = Application.Transpose(Application.Transpose(Rng.Resize(, 4).Value))
   
10.    s = s + 1
    
11.    End If
    
12.    End With
    
13.    Next
    
14. End With
    
15. With Sheets("¤ñ¹ï«á¸ê®Æ")
    
16. .[A1].CurrentRegion.Offset(1) = ""
    
17. .[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
    
18. End With
    
19. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 3# eric093

1. Sub ex()
   
2. Dim A As Range, Rng As Range, Ar(), s&
   
3. With Sheets("¦W³æ")
   
4.    For Each A In .Range(.[A2], .[A2].End(xlDown))
   
5.    With Sheets("¸ê®Æ¨Ó·½")
   
6.    Set Rng = .[A:A].Find(A, lookat:=xlWhole)
   
7.    If Not Rng Is Nothing Then
   
8.    For Each c In .Range(Rng, Rng.End(xlDown))
   
9.    If c = A Then
   
10.       ReDim Preserve Ar(s)
    
11.       Ar(s) = Application.Transpose(Application.Transpose(c.Resize(, 4).Value))
    
12.       s = s + 1
    
13.    End If
    
14.    Next
    
15.    End If
    
16.    End With
    
17.    Next
    
18. End With
    
19. With Sheets("¤ñ¹ï«á¸ê®Æ")
    
20. .[A1].CurrentRegion.Offset(1) = ""
    
21. .[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
    
22. End With
    
23. End Sub

½Æ»s¥N½X