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 
