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行的“重复”），并用d + p + m替换第1行的第D列。我设法提出以下代码：

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

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

1 个答案: