用VBA实现代替SUMPRODUCT

netbar2008

之前是用SUMPRODUCT，现在想用VBA实现按类目，分类汇总每个产品的销售数据，
里面有部分代码，麻烦大神们帮我修改下，谢谢

于箱长

好像把类目和名称整混了，改过来就好了吧

于箱长

opel-wong大神不是已经帮你写完了吗？

netbar2008

初学VBA有些代码还看不太懂

opel-wong

netbar2008 发表于 2020-3-14 22:08
初学VBA有些代码还看不太懂

一楼附件中的代码好像是我写过的，好熟悉的感觉，

excel海

自己不明白,提供数据的时候有乱搞,给你写了改都不明白,让人怎么写? 这平台主要还是学习吧

netbar2008

运行时数据出不来

netbar2008

产品一样时数量汇总不起来

于箱长

发了三个帖子，全是这一个事儿，不知道你的最终使用的版本和这次改过的版本到底还有多大出入，比如说，你的第二行，茶叶、茶具之类的，等你的明细表行数越来越多的时候，是否做为一个条件参与计算，你原表的sumproduct函数并没有体现这部分，我倒是修改了部分代码，并计算出了结果

lkqsmxw

Sub 汇总数据()
    Dim arr, i As Long, mRow As Long, j As Integer, k As Long, Keys, Its, m, BRR
    Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
    Worksheets("3月数据汇总").Range(Worksheets("3月数据汇总").Cells(4, 2), Worksheets("3月数据汇总").Cells(65536, 24)).ClearContents
    With Worksheets("3月明细表")
        mRow = .Range("B65536").End(3).Row
        arr = .Range("B3:U" & mRow).Value
    End With
    Dim pName$, mNumber&, TotalCost#, mSales#, GrossProfit#, pNameB$
    For i = 1 To UBound(arr)
        pName = arr(i, 1) & "│" & arr(i, 4)
        mNumber = Val(arr(i, 5))
        TotalCost = Val(arr(i, 14))
        mSales = Val(arr(i, 10)) + Val(arr(i, 11)) + Val(arr(i, 9))
        GrossProfit = mSales - TotalCost
        If Len(pName) And Not d.Exists(pName) Then d(pName) = Array(mNumber, TotalCost, mSales, GrossProfit) Else d(pName) = Array(mNumber + mNumber, TotalCost + TotalCost, mSales + mSales, GrossProfit + GrossProfit)
    Next
    With Worksheets("3月数据汇总")
        .Activate
        mRow = Cells.Find("*", , , , 1, 2).Row
        BRR = .Range(.Cells(4, 2), .Cells(mRow, 24)).Value
        Keys = d.Keys
        Its = d.items
        For j = 2 To UBound(BRR, 2) Step 6
            pNameB = .Cells(2, j + 1)
            m = 0
            For i = 0 To UBound(Keys)
                If pNameB = Split(Keys(i), "│")(0) Then
                    m = m + 1
                    BRR(m, j - 1) = Split(Keys(i), "│")(1)
                    For k = 2 To 5
                        BRR(m, k + j - 2) = Its(i)(k - 2)
                    Next
                End If
            Next
        Next
        .Range(.Cells(4, 2), .Cells(mRow, 24)).Value = BRR
    End With
    Set d = Nothing
End Sub