Sub 为什么会删图呢()
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
If Not d.Exists(arr(i, 1)) Then
If arr(i, 3) = "GG" Or arr(i, 3) = "HH" Then
d(arr(i, 1)) = Array(arr(i, 1), arr(i, 2), 0)
ElseIf arr(i, 3) = "JJ" Then
d(arr(i, 1)) = Array(arr(i, 1), 0, arr(i, 2))
End If
Else
If arr(i, 3) = "GG" Or arr(i, 3) = "HH" Then
d(arr(i, 1)) = Array(arr(i, 1), d(arr(i, 1))(1) + arr(i, 2), d(arr(i, 1))(2))
ElseIf arr(i, 3) = "JJ" Then
d(arr(i, 1)) = Array(arr(i, 1), d(arr(i, 1))(1), d(arr(i, 1))(2) + arr(i, 2))
End If
End If
Next i
[e1:g1] = [{"型号","数量GG+HH","数量JJ"}]
[e2].Resize(d.Count, 3) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(d.Items))
End Sub

没看懂为什么要用字典的思路去做

没必要强行字典，