Excel表格制作教程-合并相同项,并将对应的值求和

要求:

        1、将相同ID号,相同物料的行合并

        2、将同一个ID号的所有项都相加求和

 

Excel表格制作教程-合并相同项,并将对应的值求和_第1张图片

Excel表格制作教程-合并相同项,并将对应的值求和_第2张图片

附上代码:

Sub test1()
    Dim d1 As Object, d2 As Object, arr, i As Integer, k, brr
    Set d1 = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    Set d3 = CreateObject("scripting.dictionary")
    
    arr = Range("c4").CurrentRegion
    For i = 5 To UBound(arr)
        If Len(arr(i, 3)) Then
            If d1(arr(i, 3)) = "" Then  '如果是否有数据
                d1(arr(i, 3)) = arr(i, 9) '如果该关键字第一次出现
                d3(arr(i, 3)) = arr(i, 5)
                'MsgBox "关键字" & arr(i, 1) & Chr(13) & "条目" & d(arr(i, 1))
            Else '当该关键字出现了第二次以上
                d1(arr(i, 3)) = d1(arr(i, 3)) + arr(i, 9) '将原有的值加上新出现的值保存起来
                'MsgBox "关键字" & arr(i, 1) & Chr(13) & "条目" & d(arr(i, 1))
            End If
        End If
    Next i
    f = 5
    For Each k In d1.keys '遍历每一个关键字
        Cells(f, "l") = k
        Cells(f, "m") = d3(k)
        Cells(f, "n") = d1(k)
        f = f + 1
    Next k
    f = 0
   
End Sub
 

你可能感兴趣的:(Excel)