Zufallsgenerator Fußballauslosung mehrere Gruppen

Hallo liebe Leute,
ich habe leider wirklich wenig Ahnung von Makros. Aufgrund der Suchfunktion habe ich schon eine Lösung zu meinem Porblem gefunden, jedoch ist das nicht genau das was ich suche.
Wir haben ein Fußballturnier und dafür werden Mannschaften ausgelost. Es gibt 5 Töpfe in denen die Spieler nach Mannschaft getrennt sich befinden. Jetzt sollen diese per Klick auf eine Schaltfläche per Zufall sortiert werden. Und zwar so, dass jeder Topf (topf1 in Spalte A; topf2 in Spalte B usw..) nacheinander abgearbeitet wird.
Es soll eigentlich so sein wie in diesem Beispiel, auch mit der Gruppenanzahl Auswahl, jedoch sollen bei mir nicht nur aus Spalte A sondern aus A bis einschließlich E die Personen per Zufall nacheinander aus ihren Töpfen den Mannschaften der Reihenfolge nach zugeordnet werden.

Die Datei https://www.herber.de/bbs/user/14676.xls wurde aus Datenschutzgründen gelöscht

Vielen Dank schonmal!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Pascal,
das kannst Du so machen:


Option Explicit
Sub ZufallsNamen()
Dim rng As Range
Dim var As Variant
Dim intRowAll As Integer, intCell As Integer, intCol As Integer, intCollall as Integer
Dim intRow As Integer, intAct As Integer, incolAct as Integer
Dim strName As String
Columns("F:IV").ClearContents
var = InputBox("Anzahl Gruppen:", , 3)
If var = "" Then Exit Sub
If Not IsNumeric(var) Then Exit Sub
For intCol = 1 To CInt(var)
Cells(7, intCol + 2) = "Gruppe" & CStr(intCol)
Next intCol
Randomize
intRowAll = Range("A1").CurrentRegion.Rows.Count
intColAll = Range("A1").CurrentRegion.Columns.Count
intRow = 3
intCol = 7
For intCell = 1 To intRowAll * intColAll
intAct = Int((intRowAll * Rnd) + 1)
intColAct = Int((intColAll * Rnd) + 1)
strName = Cells(intAct, intColAct).Value
Set rng = Range("G2").CurrentRegion.Find(strName, lookat:=xlWhole, LookIn:=xlValues)
Do While Not rng Is Nothing
strName = ""
Do while strName = ""
intAct = Int((intRowAll * Rnd) + 1)
intColAct = Int((intColAll * Rnd) + 1)
strName = Cells(intAct, intColAct).Value
loop
Set rng = Range("G2").CurrentRegion.Find(strName, lookat:=xlWhole, LookIn:=xlValues)
Loop
Cells(intRow, intCol) = strName
intCol = intCol + 1
If IsEmpty(Cells(2, intCol)) Then
intRow = intRow + 1
intCol = 7
End If
Next intCell
End Sub

Ist aber aufgrund der 3 Spalten und der dadurch vile größeren Anzahl an Möglichkeiten der Zufallszahlen
wesentlich langsamer.
Gruß
yummi

Sub ZufallsNamen() Dim rng As Range Dim var As Variant Dim intRowAll As Integer, intCell As Integer, intCol As Integer, intColAll As Integer Dim intRow As Integer, intAct As Integer, intColAct As Integer Dim strName As String Columns("F:IV").ClearContents var = InputBox("Anzahl Gruppen:", , 3) If var = "" Then Exit Sub If Not IsNumeric(var) Then Exit Sub For intCol = 1 To CInt(var) Cells(7, intCol + 2) = "Gruppe" & CStr(intCol) Next intCol Randomize intRowAll = Range("A1").CurrentRegion.Rows.Count intColAll = Range("A1").CurrentRegion.Columns.Count intRow = 3 intCol = 7 For intCell = 1 To intRowAll * intColAll intAct = Int((intRowAll * Rnd) + 1) intColAct = Int((intColAll * Rnd) + 1) strName = Cells(intAct, intColAct).Value Set rng = Range("G2").CurrentRegion.Find(strName, lookat:=xlWhole, LookIn:=xlValues) Do While Not rng Is Nothing strName = "" Do While strName = "" intAct = Int((intRowAll * Rnd) + 1) intColAct = Int((intColAll * Rnd) + 1) strName = Cells(intAct, intColAct).Value Loop Set rng = Range("G2").CurrentRegion.Find(strName, lookat:=xlWhole, LookIn:=xlValues) Loop Cells(intRow, intCol) = strName intCol = intCol + 1 If IsEmpty(Cells(2, intCol)) Then intRow = intRow + 1 intCol = 7 End If Next intCell End Sub

Beliebteste Forumthreads (12 Monate)

Zufallsgenerator Fußballauslosung mehrere Gruppen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zufallsgenerator Fußballauslosung mehrere Gruppen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread