Liste auswerten

Option Explicit
Sub liste_auswerten()
' findet in einer Liste, die nicht sortiert sein muss
' alle vorkommenden Artikel. Diese werden mit dem Einzelpreis
' und der Gesamtanzahl in einer neuen Liste ausgegeben.
' Der Gesamtpreis wird errechnet.
' Geschrieben von Klaus-Dieter Oppermann, Oktober 2005

' Variablen deklarieren
Dim iZiel As Integer                        ' Letzte gefüllte Zelle
Dim az As Integer                           ' Zähler für Arrayfelder
Dim i As Integer                            ' Schleifenzähler (Arrays füllen)
Dim t As Integer                            ' Schleifenzähler (Gesamtpreise und Gesamtanzahl ermitteln)
Dim arr() As Variant                        ' Array für Artikelausgabe
Dim arr2() As Variant                       ' Array für Einzelpreisausgabe
iZiel = Range("A65536").End(xlUp).Row       ' Letzte gefüllte Zelle ermitteln (in Spalte A)
' Arrays dimensionieren
ReDim arr(iZiel, 0)                         ' Artikel
ReDim arr2(iZiel, 0)                        ' Einzelpreise
' Arrays mit Werten füllen
For i = 2 To UBound(arr)                                                ' laufe von Zeile 2 bis Tabellenende
    If Application.WorksheetFunction.CountIf(Range(Cells(i, 1), _
    Cells(1, 1)), Cells(i, 1).Value) = 1 Then                           ' wenn Artikel das erste Mal vorkommt, dann ...
        arr(az, 0) = Cells(i, 1).Value                                  ' ... Name in Array einlesen
        arr2(az, 0) = Cells(i, 2).Value2                                ' ... Einzelpreis in Array einlesen
        az = az + 1                                                     ' ... Zähler für Arrayfeld plus 1
    End If                                                              ' Ende der Auswertung
Next i                                                                  ' Schleifenzähler plus 1
' Inhalte ausgeben
Range("E2", "E" & UBound(arr)) = arr                                    ' Artikelnamen in Ausgabebereich schreiben
With Range("F2", "G" & UBound(arr))                                     ' Ausgabbereich für Beträge
    .NumberFormat = "#,##0.00 $"                                        ' Währungsformat festlegen
    .Value = arr2                                                       ' Beträge eintragen
End With                                                                ' Ende des Eintrags
For t = 2 To az + 1                                                     ' laufe von Zeile 2 bis Listenende
    Cells(t, 8) = Application.WorksheetFunction.SumIf(Range _
    (Cells(232, 1), Cells(2, 1)), Cells(t, 5), Range("C2:C232"))        ' Gesamtmenge berechnen
    Cells(t, 7) = Cells(t, 8) * Cells(t, 6)                             ' Gesamtpreis berechnen
Next t                                                                  ' Schleifenzähler plus 1
Columns("E:H").EntireColumn.AutoFit                                     ' Spalten auf optimale Breite
End Sub