- Sub test()
- Dim dic As Object
- Dim v
- Dim i As Long, s
-
- Set dic = CreateObject("scripting.dictionary")
-
- v = Range("a1").CurrentRegion.Value
- For i = 2 To UBound(v)
- s = v(i, 1) & vbTab & v(i, 2)
- If Not dic.Exists(s) Then dic(s) = Array(, , 0, 0)
- dic(s) = Array(v(i, 1), v(i, 2), dic(s)(2) + 1, dic(s)(3) + v(i, 3))
- Next
-
- With Range("F1")
- .CurrentRegion.ClearContents
- .Resize(, 4).Value = [{"產品","規格","次數","總和"}]
- .Offset(1).Resize(dic.Count, 4).Value = _
- Application.Transpose(Application.Transpose(dic.Items))
- .CurrentRegion.Sort key1:=.Columns(1), Header:=xlYes
- End With
-
- End Sub
复制代码 |