合并型号和名称相同产品的库存数量

Sub test()
    Set d = CreateObject("scripting.dictionary")
    With Sheet1
        ar = .Range("a1").CurrentRegion
        For x = 2 To UBound(ar)
            s = ar(x, 1) & "," & ar(x, 2)
            If Not d.exists(s) Then
                d(s) = Array(ar(x, 3), 1, ar(x, 4))
            Else
                k = d(s)
                k(0) = k(0) + ar(x, 3)
                k(1) = k(1) + 1
                d(s) = k
            End If
        Next
    End With
    With Sheets("res")
        r = 1
        .Columns("a:a").NumberFormatLocal = "@"
        .Columns("d:d").NumberFormatLocal = "@"
        For Each a In d
            v = d(a)
            If v(1) > 1 Then
                r = r + 1
                .Cells(r, 1) = Split(a, ",")(0)
                .Cells(r, 2) = Split(a, ",")(1)
                .Cells(r, 3) = v(0)
                .Cells(r, 4) = Round(v(2), 3)
            End If
        Next
    End With
End Sub

Sub 删除()
    Set d = CreateObject("scripting.dictionary")
    With Sheet1
        ar = .Range("a1").CurrentRegion
        For x = 2 To UBound(ar)
            s = ar(x, 1) & "," & ar(x, 2)
            If Not d.exists(s) Then
                d(s) = Array(ar(x, 3), 1, ar(x, 4))
            Else
                k = d(s)
                k(0) = k(0) + ar(x, 3)
                k(1) = k(1) + 1
                d(s) = k
            End If
        Next
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For y = UBound(ar) To 2 Step -1
            ss = ar(y, 1) & "," & ar(y, 2)
            tem = d(ss)
            If tem(1) > 1 Then
                .Rows(y).Delete
            End If
        Next
    End With
End Sub