Gruppe
Allgemein
Problem
Die Liste soll so verdichtet werden, dass jeder Name nur noch einmal vorkommt und die Stückahlen jeweils addiert werden.
StandardModule: Modul1
Sub Sammeln()
Dim vRow As Variant
Dim iRow As Integer, iRowL As Integer
iRowL = WorksheetFunction.CountA(Columns(1))
For iRow = iRowL To 2 Step -1
vRow = Application.Match(Cells(iRow, 1).Value, Range(Cells(1, 1), Cells(iRow - 1, 1)), 0)
If Not IsError(vRow) Then
Cells(iRow, 4).Value = Cells(iRow, 4).Value + Cells(vRow, 4).Value
Rows(vRow).Delete
End If
Next iRow
Range("A1").CurrentRegion.Sort _
key1:=Range("A2"), order1:=xlAscending
End Sub