同类项合并，数量汇总，数据量较大，求助！！！！

longwin

只按照产品型号汇总数量：
Sub test()
    Set d = CreateObject("scripting.dictionary")
    l = 3
    Do
        l1 = Cells(l, 1).End(xlDown).Row + 1
        If Cells(l1 - 1, 1) = "*" Or Cells(l1 - 1, 1) = "" Then Exit Do
        l2 = Cells(l, 1).End(xlDown).End(xlDown).Row - 1
        arr = Range("E" & l1 & ":G" & l2)
        For i = 1 To UBound(arr)
            d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 3)
        Next
        m = d.Count
        Range("E" & l1 & ":E" & l1 + m - 1) = WorksheetFunction.Transpose(d.keys)
        Range("G" & l1 & ":G" & l1 + m - 1) = WorksheetFunction.Transpose(d.items)
        If l2 > l1 + m - 1 Then
            Rows(m + l1 & ":" & l2).Delete
        End If
        d.RemoveAll
        l = l1 + m
    Loop
End Sub

准提部林

powerremain 发表于 2024-7-1 14:59
9楼的结果是错误的
Sub text2()
Dim arr, d As Object

1) g列數量加總, i列金額不理???
2) 表格內有公式, 那刪行後會影響公式? 甚至公式錯誤(參照位址變了)?
3) 匯總一定要（产品名称+产品型号+单位）??? 只用產品型號不可以???

上萬行刪除行可能速度不會太快\\

sdytsxd991122

powerremain 发表于 2024-7-1 14:59
9楼的结果是错误的
Sub text2()
Dim arr, d As Object

能看看错误的结果？

准提部林

區域同類匯總//by.准提部林
基本操作碼
代碼不方便用中文// "序号"暫用"SerNo"代替
示例文件-v01.rar (23.67 KB, 下载次数: 13)

2024-7-1 20:06 上传

点击文件名下载附件

powerremain

sdytsxd991122 发表于 2024-7-1 17:21
能看看错误的结果？

我抄错了一句代码？感谢老师，我稍作修改，已将满足我现在使用了

powerremain

谢谢各位老师参与帮助，问题已经解决。

powerremain

longwin 发表于 2024-7-1 16:09
只按照产品型号汇总数量：
Sub test()
    Set d = CreateObject("scripting.dictionary")

是这种效果，我实际数据和我的上传的还有点不一样，已经足够了，非常感谢！