Gruppenauslosung

Hallo zusammen,
vor gut einem Jahr hatte ich die Frage schon einmal gestellt - diese wird jetzt wieder aktuell und ich bin leider immer noch nicht weiter gekommen.
Leider ist der alte Thread nicht mehr offen, deshalb musste ich einen neuen erstellen.
https://www.herber.de/bbs/user/48745.xls
Diese Auslosung stimmt vom Prinzip her mit dem überein was ich brauche , lediglich ein paar Kleinigkeiten müssten geändert werden.
Es soll die Möglichkeit geben aus 6-16 Teilnehmern zu wählen wobei immer nur ein Teilnehmer gesetzt sein soll.
Man sollte also wählen können ob in 1,2,3 oder 4 Gruppen gespielt wird und zudem soll nur der Teilnehmer, der als erstes in der Teilnehmerliste steht, in Gruppe A gesetzt sein. Die restlichen Teilnehmer sollen dann abwechselnd in die Gruppen zugelost werden. Quasi exakt so wie in der oben genannten Datei. (mit der Show ;-) )
Hier als Beispiel das Layout für 2 Gruppen:
https://www.herber.de/bbs/user/62866.xls
Vielen Dank schon einmal an die Experten!
Gruß Mario

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Mario,
mein Ansatz:
- Tabellenname = Tabelle1
- Namen der Teilnehmer stehen in Spalte B ab Zeile 2
- Ergebnis: Gruppennummer in Spalte D, Spielernamen in Spalte E.
das geht bestimmt noch eleganter, aber gib mir Bescheid wie du damit zurecht kommst.
Gruß
Christian


Option Explicit
Sub SetPlayer()
Dim lngGrp&, lngR&, i&, r&
Dim hsh As Object, vPlyr, vRes()
Set hsh = CreateObject("Scripting.Dictionary")
lngGrp = 5                                          'Spieler pro Gruppe
With Sheets("Tabelle1")
.Columns(4).Resize(, 2).Clear
If .Cells(2, 2).Text = "" Then Exit Sub
lngR = .Cells(.Rows.Count, 2).End(xlUp).Row - 1
For i = 1 To lngR
hsh(i) = .Cells(i + 1, 2).Text
Next
ReDim vRes(1, lngR - 1)
vRes(0, 0) = 1
vRes(1, 0) = .Cells(2, 2).Text                  '1. Spieler fix
vPlyr = hsh.Keys
Randomize
For i = 1 To lngR - 1
r = Int((lngR - i) * Rnd)
vRes(0, i) = (i \ lngGrp) + 1
vRes(1, i) = hsh(vPlyr(r))
hsh.Remove vPlyr(r)
vPlyr = hsh.Keys
Next
.Cells(2, 4).Resize(lngR, 2) = Application.Transpose(vRes)
End With
End Sub

Option Explicit Sub SetPlayer() Dim lngGrp&, lngR&, i&, r& Dim hsh As Object, vPlyr, vRes() Set hsh = CreateObject("Scripting.Dictionary") lngGrp = 4 'Spieler pro Gruppe With Sheets("Tabelle1") .Columns(4).Resize(, 2).Clear If .Cells(2, 2).Text = "" Then Exit Sub lngR = .Cells(.Rows.Count, 2).End(xlUp).Row - 2 .Cells(2, 4) = 1 .Cells(2, 5) = .Cells(2, 2) '1. Spieler fix For i = 1 To lngR hsh(i) = .Cells(i + 2, 2).Text Next ReDim vRes(1, lngR - 1) vPlyr = hsh.Keys Randomize For i = 0 To lngR - 1 r = Int((lngR - i) * Rnd) vRes(0, i) = ((i + 1) \ lngGrp) + 1 vRes(1, i) = hsh(vPlyr(r)) hsh.Remove vPlyr(r) vPlyr = hsh.Keys Next .Cells(3, 4).Resize(lngR, 2) = Application.Transpose(vRes) End With End Sub

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread