Sortierung Spielerliste

Hallo, ich habe mir dank diesem Forums einen kleinen TurnierPlan (Verwaltung) zusammengebastelt. Nun weiß ich aber leider nicht mehr weiter und brauche Hilfe.
Ich habe mir das auch nachgebaut und es funktioniert super. https://www.herber.de/forum/archiv/596to600/596593_Spieler_Auslosung_mit_Freilose.html#google_vignette
Nun hab ich eine Frage und zwar wäre es möglich das man diese Auslosung in einer Schleife oder so durchführen kann das einfach mehrmals durchgelost wird aber nach jeder Losung das Macro nochmal lost. Aber wichtig wäre auch das die F R E I L O S E nach jedem Durchgang wieder da hin kommen wo sie waren, sonst stimmt ja die Liste mit den gesetzten F R E I L O S E N ja nicht.
Gibt leider das Problem das einige Spieler bei einmaligen drücken denken das geschummelt wird, deshalb möchte ich das sagen wir mal das Macro 10 mal oder so hintereinander ausgeführt wird.
Wäre über jede kleine Hilfe dankbar.
Liebe Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo, sorry das meine Beschreibung etwas wage war.
es geht um folgende 2 Codes:


Sub ZufallsZahl()
Dim c As Range, Ber1 As Range, Ber2 As Range, _
ZuZ As Byte
Set Ber1 = Range("F2:F33")
Ber1.ClearContents
For Each c In Ber1
ZuZ = Int((32 * Rnd) + 1)  'Zufallszahl: 1 bis 32
Set Ber2 = Ber1.Find(ZuZ, lookat:=xlWhole)
While Not Ber2 Is Nothing
ZuZ = Int((32 * Rnd) + 1)
Set Ber2 = Ber1.Find(ZuZ, lookat:=xlWhole)
Wend
c.Value = ZuZ
Next c
Set Ber1 = Nothing
Set Ber2 = Nothing
End Sub


Sub ListeSortieren()
Dim i As Integer, _
laR As Byte, anzFr As Byte
Application.ScreenUpdating = False
'    Call ZufallsZahl
For i = 33 To 2 Step -1
If Range("D" & i).Text > "F R E I L O S" Then
laR = i
Exit For
End If
Next i
Range("C1:F" & laR).Sort Key1:=Range("F2"), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
If laR  33 Then
Range("F2").Value = 1
Range("F2").AutoFill _
Destination:=Range("F2:F33"), Type:=xlFillSeries
anzFr = 33 - laR
For i = 2 To anzFr + 1
Cells(Range("G" & i).Value + 1, 6).ClearContents
Next i
Range("F1:F33").Sort Key1:=Range("F2"), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Range(Cells(laR + 1, 6), Cells(33, 6)).Value = _
Range("G2:G" & anzFr + 1).Value
Range("C1:F33").Sort Key1:=Range("F2"), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End If
Application.ScreenUpdating = True
End Sub

Nun möchte ich das ich das Macro( Zufahlszahl generieren) und (Liste sortieren) in einem Macro augeführt werden und das sagen wir mal 10 mal hintereinander.
Es sollten aber nach jeder Runde die Freilose wieder da zurück wo sie am Anfang der Losung standen, also wie hier auf Platz 30,31 und 32:
Hoffe ich habe das verständlich erklärt.
Vielen Dank

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread