如何组合重复行并对excel中的值3列求和

Question

大家好， 我有一个问题是创建VBA excel来复制数据。

如何组合重复行并对excel中的值3列求和？

谢谢。

Answer 1

这个使用Remove Duplicates：

Sub dupremove()
Dim ws As Worksheet
Dim lastrow As Long

Set ws = Sheets("Sheet1") ' Change to your sheet

With ws
    lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    With .Range("B2:C" & lastrow)
        .Offset(, 4).FormulaR1C1 = "=SUMIF(C1,RC1,C[-4])"
        .Offset(, 4).Value = .Offset(, 4).Value
    End With
    With .Range("A1:A" & lastrow)
        .Offset(, 4).Value.Value = .Value
    End with
    .Range("E1:G" & lastrow).RemoveDuplicates 1, xlYes

End With

End Sub

Answer 2

在OP的澄清之后

编辑

试试这个

维护原始数据的解决方案：

Option Explicit

Sub main()

With Worksheets("Sheet01") '<== change "Sheet01" as per your actual sheet name

    With .Range("A1:C1").Resize(.Cells(.rows.Count, 1).End(xlUp).Row)
        .Copy
        With .Offset(, .Columns.Count + 1)
            .PasteSpecial xlPasteAll ' copy value and formats
            .Columns(2).Offset(1).Resize(.rows.Count - 1, 2).FormulaR1C1 = "=SUMIF(C1,RC1,C[-" & .Columns.Count + 1 & "])"
            .Value = .Value
            .RemoveDuplicates 1, xlYes
        End With
    End With

End With
End Sub

解决方案覆盖原始数据（保留供参考）：

Sub main()
Dim helperRng As Range, dataRng As Range
Dim colToFilter As String
Dim colsToSumUp As Long

With Worksheets("Sheet01") '<== change "Sheet01" as per your actual sheet name
    Set dataRng = .Range("A2:C2").Resize(.Cells(.rows.Count, 1).End(xlUp).Row - 1)
    colToFilter = "A" ' set here the column header you want to sum up on
    colsToSumUp = 3 ' number of adjacent columns to sum up with
    Set helperRng = dataRng.Offset(, .UsedRange.Columns.Count + 1).Resize(, 1) 'localize "helper" cells first column out of sheet used range
    With helperRng
        .FormulaR1C1 = "=RC" & Cells(1, colToFilter).Column 'make a copy of the values you want to sum up on
        .Offset(, 1).FormulaR1C1 = "=if(countif(R1C[-1]:RC[-1], RC[-1])=1,1,"""")" 'localize with "1" first occurrence of each unique value
        With .Offset(, 2).Resize(, colsToSumUp)
            .FormulaR1C1 = "=sumif(C" & helperRng.Column & ", RC" & helperRng.Column & ",C[" & Cells(1, colToFilter).Column - helperRng.Column - 1 & "])" 'sum up in adjacent columns
            .Value = .Value 'get rid of formulas
        End With
        .Offset(, 1).SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Delete 'delete rows with repeted values you want to sum up on
        dataRng.Columns(2).Resize(.rows.Count, colsToSumUp).Value = .Offset(, 2).Resize(.rows.Count, colsToSumUp).Value 'copy summed up values from "helper" cells
        helperRng.Resize(, 1 + 1 + colsToSumUp).Clear 'clear "helper" cells
    End With

End With

End Sub

它的注释使您可以按照代码并适应您的实际数据“结构”