相同项求和，代码一直出错

骑着猪飞奔啊

如图片所示，G列是E列数据的汇总（同一个A列项）。即，G列要求出，同一个A列项的所有E列对应数据的求和。
我的代码如下（小白代码），就是不知道为什么怎么都在后面（I,J等）列不能得出A列项相同的数据。我很奇怪，想了很久很久！望各位老师帮忙！
若各位老师有更方便的代码，也可告知。谢谢！

For i3 = 1 To i1
                b1 = 1
              skey1 = Cells(i3, 12).Value
                b2 = b2 + 1
                 i4 = i3 + 1
                  For i5 = 1 To i1
                     If Cells(i5, 12).Value = skey1 Then
                        Cells(b1, b2).Value = Cells(i3, 15).Value
                         b1 = b1 + 1
                     End If
                   Next i5

                   Cells(i3, 16).Value = Application.WorksheetFunction.Sum(Range(Cells(1, b2), Cells(1999, b2)))

             Next i3

liulang0808

建议楼主上传有代码的附件，并结合附件举例说明要做什么及模拟结果，

zopey

G1公式 下拉
=SUMPRODUCT((A$1:A$6=A1)*(E$1:E$6))

骑着猪飞奔啊

liulang0808 发表于 2018-7-9 16:21
建议楼主上传有代码的附件，并结合附件举例说明要做什么及模拟结果，

老师，你好。A列为序号，B列为金额，C列为相同序号的汇总。求C列数据

jiminyanyan

骑着猪飞奔啊 发表于 2018-7-9 20:34
老师，你好。A列为序号，B列为金额，C列为相同序号的汇总。求C列数据

Sub 例1()
    Dim arr, str, brr(1 To 10000, 1 To 1), i
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    With Worksheets("Sheet1")
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range("a2:b" & r)
        For i = 1 To UBound(arr)
            d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
        Next
        For i = 1 To UBound(arr)
            brr(i, 1) = d(arr(i, 1))
        Next
        .Range("c2:c10000").ClearContents
        .Range("c2").Resize(UBound(brr), 1) = brr
    End With
End Sub

骑着猪飞奔啊

jiminyanyan 发表于 2018-7-9 20:50
Sub 例1()
    Dim arr, str, brr(1 To 10000, 1 To 1), i
    Dim d As Object

谢谢老师，万分感谢！