Code anpassen-suchen-zusammenzählen
24.04.2008 21:36:29
Becker
Habe ein Problem, und hoffe irgendeiner kann mir helfen.
Da ich der Anfänger bit traue ich mich noch nicht selber den Code von Klaus-Dieterman (s.u.) zu verändern.
Ich habe in Tabelle1 eine Liste mit Artikel Numer(ab A2), Artiken Name (ab B2) und Stück Anzahl (ab C2)
-Artikel Numer(ab A2) bestehn aus 3 und 4 Stelligen Zahlen(keine Buchstaben oder Sonderzeichen dazw.)
-Artiken Name (ab B") sind alle in normalen Schrift
-Stück Anzahl (ab C2) ist immer Nummerisch
In diese Liste widerholen sich öfters gleiche Artikel Nummer, gleiche Artikel Name nur der Stück Anzahl ist immer unterschiedleich.
Ich möchte mit Hilfe Makro das die Spalten A, B und C durchgesucht wird und in erste frei Spalte die zusammengezählten Artikel mit Artikel Nummer untereinander zusammen addiert.
Als Beispiel:
Artikel Nr. Artikel Name Lager Bestände
Spalte A Spalte B Spalte C
1212 Copeland 2
587 Verdichter DKM 2
654 Hammer 6
1212 Copeland 10
697 kl. Mutter 22
587 Verdichter DKM 7
1212 Copeland 3
587 Verdichter DKM 1
1212 Copeland 5
So sollte danach aussehen:
Artikel Nr. Artikel Name Lager Bestände
Spalte D Spalte E Spalte F
587 Verdichter DKM 10
654 Hammer 6
697 kl. Mutter 22
1212 Copeland 20
Der untere Code von Klaus durchsucht die Namen aus Spalte "A" also keine Artikel Nummer.
Und schreibt es in erste freie Spalte alle Namen nur einmalig un addiert die Werte und multipliziert mit den Preis.
Da ich leider wenig Ahnung von VBA habe traue ich mich nicht den Code zum umbauen.
Besten Dank schon mal im Voraus!
Gruß
Daniel
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