Hsieh

1. Sub ex()
   
2. Set dic = CreateObject("Scripting.Dictionary")
   
3. With Sheets(1)
   
4. For Each a In .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
   
5. If IsEmpty(dic(a & a.Offset(, 1))) Then
   
6. ar = Application.Transpose(Application.Transpose(a.Resize(, 4).Value))
   
7.    dic(a & a.Offset(, 1)) = ar
   
8.    Else
   
9. ar = dic(a & a.Offset(, 1))
   
10. ar(4) = a.Offset(, 3)
    
11.    dic(a & a.Offset(, 1)) = ar
    
12. End If
    
13. Next
    
14. End With
    
15. Sheets(2).[A:D].ClearContents
    
16. Sheets(2).[A1].Resize(dic.Count, 4) = Application.Transpose(Application.Transpose(dic.items))
    
17. End Sub

½Æ»s¥N½X

¦^´_ 3# rouber590324