vba - 对重复行求和，然后删除所有重复项

Question

我有一个 Excel 表，其中某些行可能包含与其他行相同的数据，但一列除外。我需要一个宏来汇总该列中的所有值并删除所有重复项，第一个除外，其中包含其余部分的总和。例如:

   A   B   C   D
1  a   b   c   d
2  n   j   i   o
3  a   b   c   p
4  v   y   e   b
5  a   b   c   m
6  .   .   .   .

在这种情况下，代码必须删除第 3 行和第 5 行(因为它们是第 1 行的“重复”)，并将第 1 行的 D 列替换为 d+p+m。我设法想出了以下代码:

For j = 1 To Range("A1").End(xlDown).Row
    For i = j + 1 To Range("A1").End(xlDown).Row
        If Cells(j, 1).value = Cells(i, 1).value And Cells(j, 2).value = Cells(i, 2).value And Cells(j, 3).value = Cells(i, 3).value Then
            Cells(j, 6) = Cells(i, 6).value + Cells(j, 6).value
            Rows(i).Delete Shift:=xlUp
            i = i - 1
        End If
    Next i
Next j

但正如您可能已经注意到的那样，它非常低效且基本。有更好的想法吗？

Answer 1

这是一个简单的代码:

Sub remdup()
    Dim ws As Worksheet
    Dim lastrw As Long
    Set ws = ActiveSheet
    lastrw = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    ws.Range("E1:E" & lastrw).FormulaR1C1 = "=SUMIFs(C[-1],C[-4],RC[-4],C[-3],RC[-3],C[-2],RC[-2])"
    ws.Range("D1:D" & lastrw).Value = ws.Range("E1:E" & lastrw).Value
    ws.Range("E1:E" & lastrw).ClearContents
    With ws.Range("A1:D" & lastrw)
        .Value = .Value
        .RemoveDuplicates Array(1, 2, 3), xlNo
    End With

End Sub