代码修正

搬砖玄武

   Sub 订单分解()
   arr = Sheets("订单分解").UsedRange
   Set d = CreateObject("Scripting.dictionary")
   For j = 2 To UBound(arr)
   d(arr(j, 8)) = d(arr(j, 8)) + Val(arr(j, 11))
   Next j
   For Each key In d.Keys
   For j = 2 To UBound(arr)
   If arr(j, 8) = key Then
   arr(j, 12) = d(key)
   Exit For
   End If
   Next j
   Next key
   Sheets("订单分解").UsedRange = arr
   End Sub
    这段代码实现同类汇总，现需要实现下列图标同类逐步统计汇总，不是一次全部汇总，而是逐步同类汇总，请问大神该更改上述代码

taller

没有示例文件，大家如何帮你调试代码？最后两行订单总量列为何为空？

桑榆非晚123

由于是逐步累加，每次更新完字典的值，直接写入12列即可，代码如下:
Sub 订单分解()
    Dim arr As Variant
    Dim d As Object
    Dim i As Long, j As Long
   
    ' 读取当前工作表的使用范围到数组中
    arr = Sheets("订单分解").UsedRange
   
    ' 创建一个字典对象来保存同类的汇总值
    Set d = CreateObject("Scripting.Dictionary")
   
    ' 遍历数组的每一行（从第2行开始，假设第1行是标题）
    For i = 2 To UBound(arr, 1)
        Dim currentKey As String
        Dim currentValue As Double
        
        ' 获取当前行的关键键值（根据第8列作为分类标志）
        currentKey = arr(i, 8)
        
        ' 获取当前行需要累加的值（第11列）
        currentValue = Val(arr(i, 11))
        
        ' 更新字典中当前键的累积值（如果键不存在则初始化为0）
        If Not d.exists(currentKey) Then
            d(currentKey) = 0
        End If
        d(currentKey) = d(currentKey) + currentValue
        
        ' 将当前累加后的值放入数组的第12列
        arr(i, 12) = d(currentKey)
    Next i
   
    ' 将更新后的数组写回工作表
    Sheets("订单分解").UsedRange = arr
End Sub