oobird

1. Sub xx()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. a = [a1].CurrentRegion
   
4. For i = 1 To UBound(a)
   
5. k = a(i, 1) & a(i, 2)
   
6. If Not d.exists(a(i, 1) & a(i, 2)) Then
   
7. d(k) = Application.Index(a, i)
   
8. Else
   
9. d(k) = Array(d(k)(1), d(k)(2), d(k)(3), d(k)(4) + a(i, 4))
   
10. End If
    
11. Next
    
12. [a9].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(d.items))
    
13. End Sub

複製代碼