Hsieh

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. With ¤u§@ªí1
   
4.    For Each a In .Range(.[A1], .[A1].End(xlDown))
   
5.       mystr = a & a.Offset(, 1) & a.Offset(, 2) & a.Offset(, 4)
   
6.       If d.exists(mystr) Then MsgBox a & "¸ê®Æ­«½Æ"
   
7.       d(mystr) = Application.Transpose(Application.Transpose(a.Resize(, 6).Value))
   
8.    Next
   
9. End With
   
10. With ¤u§@ªí2
    
11. .Cells.ClearContents
    
12. .[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
    
13. End With
    
14. End Sub

½Æ»s¥N½X

¦^´_ 5# jackyliu