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

powerremain

按照E列的产品型号合并同类项，把G列的数量汇总过来，如果在原文件上实现最好，保留原文件新建一个也可以

413254881

powerremain

413254881 发表于 2024-6-30 02:29

能否发一个源代码

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("D" & l1 & ":I" & l2)
For i = 1 To UBound(arr)
    s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
    If Not d.exists(s) Then
        d(s) = Array(arr(i, 4), arr(i, 5), arr(i, 6))
    Else
        d(s) = Array(d(s)(0) + arr(i, 4), arr(i, 5), d(s)(2) + arr(i, 6))
    End If
Next
ReDim brr(1 To d.Count, 1 To 6)
m = 0
For Each Key In d
    m = m + 1
    brr(m, 1) = Split(Key, "|")(0)
    brr(m, 2) = Split(Key, "|")(1)
    brr(m, 3) = Split(Key, "|")(2)
    brr(m, 4) = d(Key)(0)
    brr(m, 5) = d(Key)(1)
    brr(m, 6) = d(Key)(2)
Next
Range("D" & l1 & ":I" & l1 + m - 1) = brr
If l2 > l1 + m - 1 Then
Rows(m + l1 & ":" & l2).Delete
End If
d.RemoveAll
l = l1 + m
Loop
End Sub

wang-way

longwin 发表于 2024-6-30 15:16
Sub test()
Set d = CreateObject("scripting.dictionary")
l = 3

请教一下  d(s)(0)是不是只能读不能写？

longwin

wang-way 发表于 2024-6-30 15:36
请教一下  d(s)(0)是不是只能读不能写？

应该是不能单独写，只能把数组整体重新赋值后写入

wang-way

longwin 发表于 2024-6-30 16:46
应该不是不能单独写，只能把数组整体重新赋值后写入

恩，我的意思就是不能直接通过索引去写。看来是这样，只能整个数组重新写进去。

准提部林

要保留原表格式???

sdytsxd991122

原表删行

powerremain

准提部林 发表于 2024-6-30 18:08
要保留原表格式???

是的 保留原格式 前面的格式变了