Gruppe
Allgemein
Bereich
Vergleich
Thema
Liste nach Namen verdichten
Problem
Die Liste soll so verdichtet werden, dass jeder Name nur noch einmal vorkommt und die Stückahlen jeweils addiert werden.
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
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