时间戳

首页 > 解决方案 > 重复行总和

excel - 重复行总和

问题描述

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

只有第一个重复的行被求和。然后，该值将出现在下面的所有行中。

示例表 - 五列
在此处输入图像描述

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

标签： excelvba

解决方案

最后一个循环中的转换行应该处理正确的行值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

进一步提示：

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

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

推荐阅读