Gruppenauslosung

Forumthread: Gruppenauslosung

Gruppenauslosung

Mario

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

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Gruppenauslosung

Christian
AW: Gruppenauslosung

Christian

AW: Gruppenauslosung

03.07.2009 01:05:42

Christian

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

AW: Gruppenauslosung

03.07.2009 09:45:30

Christian

...in dem letzten war noch ein Fehler drin, hier die Korrektur.
Rückmeldung wäre nett - Gruß Christian


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)

Forumthread: Gruppenauslosung

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

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread