Question

我正在尝试合并表中重复的行，同时对最后一列中的数字求和，然后在下方创建一个新的汇总表。

仅对第一个重复的行进行求和。然后该值出现在下面的所有行中。

示例表 - 五列

Sub CombineDupesV3()
    
    Dim x       As Long
    Dim r       As Long
    Dim arr()   As Variant
    Dim dic     As Object
    Const DELIM As String = "|"
    
    Set dic = CreateObject("Scripting.Dictionary")
    
    x = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Cells(1, 1).Resize(x, 5).Value
    
   
    For x = LBound(arr, 1) + 1 To UBound(arr, 1)
        
        If dic.exists(arr(x, 1)) Then
            arr(x, 5) = arr(x, 5) + CDbl(Split(dic(arr(x, 1)), DELIM)(3))
            
        Else
            dic(arr(x, 1)) = arr(x, 2) & DELIM & arr(x, 3) & DELIM & arr(x, 4) & DELIM & arr(x, 5)
        End If
        dic(arr(x, 1)) = arr(x, 2) & DELIM & arr(x, 3) & DELIM & arr(x, 4) & DELIM & arr(x, 5)
        
        Debug.Print "X = " & x
    Next x
    
    
    r = UBound(arr, 1) + 2
    
    Application.ScreenUpdating = False
    
    Cells(r, 1).Resize(, 5).Value = Cells(1, 1).Resize(, 5).Value
    
    r = r + 1
    
        
     For x = 0 To dic.Count - 1
        Cells(r + x, 1).Value = dic.keys()(x)
        Cells(r + x, 2).Resize(, 4).Value = Split(dic.items()(x), DELIM)
        Cells(r + x, 5).Value = CDbl(Cells(r, 5).Value)
        
        Debug.Print "R = " & r
    Next x
    
    Application.ScreenUpdating = True
    
    
    Erase arr
    Set dic = Nothing
    
End Sub

Answer 1

最后一个循环中的转换行应该寻址正确的行值 r + x

For x = 0 To dic.Count - 1
    Cells(r + x, 1).Value = dic.keys()(x)
    Cells(r + x, 2).Resize(, 4).Value = Split(dic.items()(x), DELIM)
    '>> convert string to double <<
    Cells(r + x, 5).Value = CDbl(Cells(r + x, 5).Value)
Next x

更多提示：

尝试完全限定所有范围引用，以避免出现不需要的结果，因为默认情况下不合格的单元格地址引用活动工作表，这不一定是您想到的:-)

您应该重新定义数据范围定义或目标范围，因为如果您运行两次代码，它们可能会发生冲突。

重复行总和

1 个答案: