Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1608to1612
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Do until schleife
24.02.2018 21:18:43
Potter
Guten Abend zusammen,
ich habe bislang den nachfolgenden Code erstellt.
Das Problem, das ich habe, es gelingt mir nicht die do while schleife zu formulieren.
Die Schleife soll solange laufen, bis in dem Zellbereich D7 bis D18 keine Leerzellen mehr sind.
Bzw. alle Zellen (D7 bis D18) von dem Code innerhalb der Do while Schleife gefüllt wurden.
Es wäre toll, wenn mir jemand helfen könnte.
Grüße,
Potter
Sub Bewertung()
Dim Bwert As Double
Dim Max As Double
Dim Rng As Range
Dim maxValue As Double
Dim cell As Range
Set Rng = Range("I7:I18")

'Do Until Range("D7:D18").Value  ""
Bwert = WorksheetFunction.CountIf(Range("D7:D18"), "")
For Each cell In Rng
cell.Select
If cell.Value > maxValue And cell.Offset(0, -5) = "" Then maxValue = cell.Value
Next cell
Range("I7:I18").Find(What:=maxValue, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(0, -5).Value = Bwert
' Loop
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Do until schleife
24.02.2018 22:33:40
onur
Entweder "Do While" ODER "for next" - aber nicht beides.
Schreib doch einfach mal, was das makro GENAU machen soll.
AW: Do until schleife
25.02.2018 08:03:40
Potter
Hallo Onur,
vielen Dank für Deine Antwort.
Die Idee ist folgende, ich habe in der Spalte I Ergebnisse, hoch ist gut, niedrig ist schlecht.
In Spalte D sollen nun Punkte für diese Ergebnisse verteilt werden. Die höchste Punktzahl entspricht der Anzahl der Teilnehmer. Höchstes Ergebnis z.B. 25, bei 7 Teilnehmern, bedeutet 7 Punkte für den Spieler mit Ergebnis 25. Gibt es zwei Spieler mit 25 bekommen beide 7 Punkte und der nächst niedrige Wert z.B. 23 bekommt nur noch 5 Punkte und das dann solange bis jeder Spieler seine Punkte (Spalte D) hat. Die jeweils noch zu vergebenden Punkte ermittle ich über die countif Funktion indem ich die leeren Zellen in der Range zähle. Die Schleife kommt zum Ende wenn die Countif Funktion den Wert Null erreicht hat.
Vom Gefühl her würde ich sagen, ich benötige eine Schleife in der Schleife. Daher hatte ich angenommen, die For Each Schleife in der Do Until Schleife würde mich zum Ziel bringen.
Ich habe mit RANG und RANGGLEICH experimentiert, aber mit den Formeln paßt die Punktevergabe nicht bei doppelten Ergebnissen.
Grüße,
Potter
Anzeige
AW: Do until schleife
25.02.2018 11:23:56
Rainer
Hallo Potter,
Wenn du Rang mit gleichen Punkzahlen hast, dann mache ich immer folgenden Trick:
Deine Formel für die Punktzahl ergänzt du um "+Zeile()*1e-9". Dann sortiert RANG gleiche Punktzahlen nach ihrer Zeilennummer.
Gruß, Rainer
AW: Do until schleife
25.02.2018 11:56:43
Potter
Hallo Rainer,
vielen Dank für die Rückmeldung.
Ich glaube,ich habe es jetzt.
Sub Bewertung()
Dim Bwert As Double
Dim Max As Double
Dim Rng As Range
Dim maxValue As Double
Dim cell As Range
Dim i As Long
Set Rng = Range("I7:I18")
For i = 1000 To 1 Step -1
Bwert = WorksheetFunction.CountIf(Range("D7:D18"), "")
maxValue = 0
For Each cell In Rng
cell.Select
If cell.Value > maxValue And cell.Offset(0, -5).Value = "" Then maxValue = cell.Value
Next cell
Range("I7:I18").Find(What:=maxValue, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Select
ActiveCell.Offset(0, -5).Value = Bwert
Range("I7:I18").FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, -5).Value = Bwert
i = Bwert
Next i
End Sub

Wie ich den Fehler abfange, wenn die Bewertung erneut angestoßen wird, obwohl es bereits Werte gibt, schaue ich mir noch an.
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige