Schleife mit zwei Bedingungen

Und wieder mal ein Problem ...
ich habe in einer Tabelle Kundendaten, die täglich aktualisiert werden. ich Sortiere die Daten nach dem ABC, so das wenn ein Kunde zwei oder mehrere Einkäufe getätigt hat diese untereinander stehen. So weit so gut.
Jetzt möchte ich das der Verkaufsbetrag zusammengezählt wird ( wenn ein Kunde mehrere Käufe getätigt hat. Das ganze sieht folgendermaßen aus:
B5_______F5______I5
Name_____Preis___Gesamtpreis
Ich hab mir volgende Schleife gebastellt:
'Gesamtbetrag Kunden
Dim AnzahlZeilen As Integer
Dim Zähler As Integer
Dim PosNameBetrag As Integer
Dim ZPosNameBetrag As Integer
Dim Wiederholung As Integer
Dim Summe As Single
Dim Name As String
'AnzahlZeilen = 16 ' wurde schon weiter oben ermittelt~f~
~f~ PosNameBetrag = 5~f~
~f~Wiederholung = 5~f~
~f~For Wiederholung = Wiederholung To AnzahlZeilen~f~
If PosNameBetrag > AnzahlZeilen Then Exit Sub 'Dieser Befehl muß Raus
~f~ Name = Sheets(2).Cells(PosNameBetrag, 2).Value~f~
~f~Zähler = 5~f~
~f~ Summe = 0~f~
~f~ZPosNameBetrag = 0~f~
For Zähler = Zähler To AnzahlZeilen
~f~ If Sheets(2).Cells(Zähler, 2).Value = Name Then ~f~
~f~ Summe = Summe + Sheets(2).Cells(Zähler, 6).Value~f~
~f~ZPosNameBetrag = ZPosNameBetrag + 1~f~
End If
Next Zähler
~f~ Sheets(2).Cells(PosNameBetrag, 9).Value = Summe~f~
~f~ PosNameBetrag = PosNameBetrag + ZPosNameBetrag~f~
MsgBox "PosNameBetrag" & PosNameBetrag
Next Wiederholung
Nachdem das Modul noch nicht fertig ist muß der Befehl If PosNameBetrag > AnzahlZeilen Then Exit Sub
raus. Ich habe versucht in der Zeile ~f~If Sheets(2).Cells(Zähler, 2).Value = Name Then mit einem and eine zweite Bedingung einzubauen. entwerder mit dem Befehl der oben raus muß und dann nicht als Exit Sub oder aber nur wenn die zu vergleichende Zelle Text enthält. ich habs nicht hinbekommen. Hab mich erst gefreut als ich das gestern Abend mit exit Sub zum laufen gebracht habe. Nach ewig langer suche im Arichv nach einer Lösung. Heute hab ich dann gemerkt, mist da kannst ja gar nicht weitermachen weil er ja beendet. :-(

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jochen,
um in einer nach Namen sortierten Liste die Summen der Einzelpreise zu jedem Namen in einer anderen Spalte auszugeben kann man eine der folgende Schleifenkonstruktion verwenden, die du an deine Verhältnisse anpassen muss.
Je nach Variante wird die Summe dabei jeweils in der 1. oder letzten Zeile des Names ausgegeben.
Gruß
Franz


Sub Test1()
'Summe wird in letzter Zeile des Namens eingetragen
Dim wks As Worksheet, lngZeile As Long
Dim strName As String, dSumme As Double
Set wks = ActiveSheet
With wks
strName = .Cells(2, 2).Value '1. Namen merken
'Werte in Spalte I löschen
If .Cells(.Rows.Count, 2).End(xlUp).Row >= 2 Then
.Range(.Cells(2, 9), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 9)).ClearContents
End If
For lngZeile = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(lngZeile + 1, 2)  strName Then 'Name in Folgezeile ist anders?
'Summenwert um Wert in Spalte F erhöhen und in Spalte I eintragen
dSumme = dSumme + .Cells(lngZeile, 6)
.Cells(lngZeile, 9) = dSumme
MsgBox "Name: " & strName & "  Summe: " & dSumme
'Neuen Namen merken und Summe zurücksetzen
strName = .Cells(lngZeile + 1, 2).Value
dSumme = 0
Else
'Zwischensumme um Wert in Spalte F erhöhen
dSumme = dSumme + .Cells(lngZeile, 6)
End If
Next
End With
End Sub
Sub Test2()
'Summe wird in 1. Zeile des Namens eingetragen
Dim wks As Worksheet, lngZeile As Long
Dim strName As String, dSumme As Double, zeileName As Long
Set wks = ActiveSheet
With wks
'Werte in Spalte I löschen
If .Cells(.Rows.Count, 2).End(xlUp).Row >= 2 Then
.Range(.Cells(2, 9), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 9)).ClearContents
End If
strName = .Cells(2, 2).Value '1. Namen merken
zeileName = 2
For lngZeile = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(lngZeile + 1, 2)  strName Then 'Name in Folgezeile ist anders?
'Summenwert um Wert in Spalte F erhöhen und in Spalte I eintragen
dSumme = dSumme + .Cells(lngZeile, 6)
.Cells(zeileName, 9) = dSumme
MsgBox "Name: " & strName & "  Summe: " & dSumme
'Neuen Namen und Zeile merken und Summe zurücksetzen
strName = .Cells(lngZeile + 1, 2).Value
zeileName = lngZeile + 1
dSumme = 0
Else
'Zwischensumme um Wert in Spalte F erhöhen
dSumme = dSumme + .Cells(lngZeile, 6)
End If
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Schleife mit zwei Bedingungen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread