Artikelnr. mehrfach, zusammen in neues Blatt
Judith
ich habe wieder mal ein Problem, bei dem ich nicht weiter komme, Vielleicht kann mir jemand von Euch helfen:
Ich habe eine Bestandsliste mit den Spalten A-C (Artikelnummer, Beschreibung, Anzahl). Die Artikelnummern können mehrfach vorkommen und sind nicht sortiert.
Ich würde gerne, dass ein neues Tabellenblatt erstellt und dort die Zusammenfassung eingetragen wird (jede Teilenummer nur 1x, die Anzahl aufaddiert).
Ich habe folgenden Code von NoNet hier im Forum gefunden, schaffe es aber nicht, ihn anzupassen weil ich keine Ahnung von Arrays habe.
Sub SummeWerteProKategorie()
Dim lngZ As Long, lngP As Long, shNeu As Worksheet
Dim colKat As New Collection
Dim arrKat(), arrWerte()
On Error Resume Next 'Zur Fehlervermeidung bei bereits vorhandenen Kategorien
For lngZ = 2 To Cells(Rows.Count, 22).End(xlUp).Row
Err.Clear 'Fehler löschen
colKat.Add Cells(lngZ, 22), Cells(lngZ, 22)
If Err = 0 Then
ReDim Preserve arrKat(colKat.Count - 1)
arrKat(UBound(arrKat)) = Cells(lngZ, 22)
ReDim Preserve arrWerte(colKat.Count - 1)
arrWerte(UBound(arrWerte)) = Cells(lngZ, 23)
Else
lngP = Application.Match(Cells(lngZ, 22), arrKat, 0) - 1
arrWerte(lngP) = arrWerte(lngP) + Cells(lngZ, 23)
End If
Next
Set shNeu = Sheets.Add 'Neues Blatt anlegen und aktivieren
shNeu.Activate
[A1:B1] = Array("Kategorien :", "Summe :")
'Kategorien und Werte in das neue Blatt übertragen :
For lngZ = 1 To colKat.Count
Cells(lngZ + 1, 1) = arrKat(lngZ - 1)
Cells(lngZ + 1, 2) = arrWerte(lngZ - 1)
Next
End Sub
Könnte mal jemand von Euch einen Blick darauf werfen?
Vielen Dank für Eure Hilfe!
Anzeige