How to SUM / merge similar rows in Excel using VBA

2019-01-19 07:51发布

问题:

I'm trying to build a simple macro in VBA for Excel that would SUM [merge] all the rows that have the same name (value in the first columns). So for example

ExampleRowA 1 0 1 1 3 4
ExampleRowA 2 1 2 2 1 0
ExampleRowC 9 7 7 7 2 5

the result should look like this

ExampleRowA 3 1 3 3 4 4
ExampleRowC 9 7 7 7 2 5

We can assume that the rows that need to be merged are not scattered, and can only appear one after another.

I did something like this, and it almost works, except I have to run it two times.

LastRow = ActiveSheet.UsedRange.Rows.Count
Set r = ActiveSheet.UsedRange.Resize(1)
With Application.WorksheetFunction


     For iRow = 2 To LastRow
        If Cells(iRow, 1) = Cells(iRow + 1, 1) Then
            LastCol = r(r.Count).Column
            SumCol = LastCol + 1
                For iCol = 2 To SumCol
                Cells(iRow, iCol) = .Sum(Range(Cells(iRow, iCol), Cells(iRow + 1, iCol)))
                Next iCol
            Rows(iRow + 1).Delete
        End If
     Next iRow

End With

I've done some programming in other scripting languages but am new to VB/VBA and don't know the possibilites/limitations of it.

In other languages I would probably use arrays but I don't get the way they work here. I can't deny that because of time constraints I prefer to learn by analyzing examples rather than reading a 500+ page VBA Bible.

回答1:

Try somthing like this:

LastRow = ActiveSheet.UsedRange.Rows.Count
Set r = ActiveSheet.UsedRange.Resize(1)
With Application.WorksheetFunction

    For iRow = LastRow-1 to 2 step -1
        do while Cells(iRow, 1) = Cells(iRow + 1, 1) 
            LastCol = r(r.Count).Column
            SumCol = LastCol + 1
               For iCol = 2 To SumCol
               Cells(iRow, iCol) = .Sum(Range(Cells(iRow, iCol), Cells(iRow + 1, iCol)))
               Next iCol
            Rows(iRow + 1).Delete
        loop
    Next iRow

End With


回答2:

This code is easier to read and does the job:

Sub Macro1()
    Dim ColumnsCount As Integer

    ColumnsCount = ActiveSheet.UsedRange.Columns.Count

    ActiveSheet.UsedRange.Activate


    Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
        If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
            For i = 1 To ColumnsCount - 1
                ActiveCell.Offset(0, i).Value = ActiveCell.Offset(0, i).Value + ActiveCell.Offset(1, i).Value
            Next
            ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Loop


End Sub


回答3:

'if you have to run the macro twice, idk put a 1: on top of your macro and on the bottom put goto 1 'that will run it twice for you 'or you can call it twice in a different macro. up to you



回答4:

For your Problem, you don't need the Macros or any VBA code.

You can start by opening the sheet with Table containing duplicate values. Follow Steps:

  1. Place the Excel Cursor, where you want the merged Data.Then, go to Data Tab > Consolidate.
  2. Consolidate Dialog box will appear.
  3. Here enter the Table which has the duplicated values and Click add to Add those values.
  4. Then, select the row/column, whichever has duplicate values. In this its the left column.
  5. Just Click OK and you are done.