Hsieh

回復 1# jasonwilliams

1. Sub Ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. For Each a In Range([C1], [C65536].End(xlUp))
   
4.    If d.exists(a.Value) = False Then
   
5.       d(a.Value) = Array(a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value, a.Offset(, 1).Value)
   
6.       Else
   
7.       ar = d(a.Value)
   
8.       ar(3) = ar(3) + a.Offset(, 1).Value
   
9.       d(a.Value) = ar
   
10.     End If
    
11. Next
    
12. Columns("A:D") = ""
    
13. [A1].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(d.items))
    
14. End Sub

複製代碼

Hsieh

回復 3# jasonwilliams

1. Private Sub CommandButton2_Click()
   
2. '這裡插入你錄製的區段
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. For Each a In Range([C1], [C65536].End(xlUp))
   
5.    If d.exists(a.Value) = False Then
   
6.       d(a.Value) = Array(a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value, a.Offset(, 1).Value)
   
7.       Else
   
8.       ar = d(a.Value)
   
9.       ar(3) = ar(3) + a.Offset(, 1).Value
   
10.       d(a.Value) = ar
    
11.     End If
    
12. Next
    
13. Columns("A:D") = ""
    
14. [A1].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(d.items))
    
15. End Sub

複製代碼

清除部份
Cells.Clear
即可

Hsieh

回復 7# jasonwilliams


    請參閱VBA說明OFFSET
當在B欄作變數迴圈時a.offset(,-2)就會產生錯誤