Letzter Stand war der folgenden: (by nighty)
Eingaben:
A2 - A26 Namen
B2 Anzahl der Spielrunden
Macro:
Option Explicit
Sub SpielerRunde()
Range(Cells(1, 3), Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row, ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)) = ""
Randomize Timer
Dim ZeilenA As Long
Dim AnzTische As Integer, SpielerRaus As Integer, endeindex As Integer, spalten As Integer, zeilen As Integer, gezogen As Integer
Dim allezahlen As Integer, t As Integer, z As Integer, zaehler As Integer, zaehler1 As Integer, ziehung As Integer, RundenS As Integer
ZeilenA = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
AnzTische = ZeilenA \ 5
SpielerRaus = ZeilenA - AnzTische * 5
endeindex = ZeilenA
spalten = 4
zeilen = 2
ReDim zuzahl(ZeilenA) As String
ReDim arr1(5, AnzTische) As Variant
ReDim arr2(5, AnzTische) As Variant
ReDim zuzahl(ZeilenA) As String
ReDim zahl(ZeilenA) As String
ReDim ArrIndex(AnzTische) As Integer
Cells(1, 1) = "NamensListe"
Cells(1, 2) = "AnzahlRunden"
Cells(1, 3) = "RausFall"
RundenS = Cells(2, 2) - 2
For zaehler = 1 To UBound(ArrIndex())
ArrIndex(zaehler) = zaehler
Cells(1, zaehler + 3) = "1 Runde " & "Tisch " & zaehler
Next zaehler
For allezahlen = 2 To ZeilenA + 1
zuzahl(allezahlen - 1) = Cells(allezahlen, 1)
Next allezahlen
For ziehung = 1 To AnzTische * 5
gezogen = Int(Rnd * endeindex) + 1
zahl(ziehung) = zuzahl(gezogen)
zuzahl(gezogen) = zuzahl(endeindex)
endeindex = endeindex - 1
ReDim Preserve zuzahl(endeindex)
Cells(zeilen, spalten) = zahl(ziehung)
If spalten = 3 + AnzTische Then
zeilen = zeilen + 1
spalten = 4
Else
spalten = spalten + 1
End If
Next ziehung
arr1() = Range(Cells(2, 4), Cells(6, 3 + AnzTische))
arr2() = Range(Cells(2, 4), Cells(6, 3 + AnzTische))
For z = 0 To RundenS
For t = 1 To 5
For zaehler1 = 2 To UBound(ArrIndex())
ArrIndex(zaehler1) = ArrIndex(zaehler1)
If ArrIndex(zaehler1) > AnzTische Then ArrIndex(zaehler1) = 1
arr2(t, ArrIndex(zaehler1)) = arr1(t, zaehler1 - 1)
Next zaehler1
arr2(t, ArrIndex(1)) = arr1(t, UBound(ArrIndex()))
Next t
Range(Cells(z * 7 + 9, 4), Cells(z * 7 + 13, 3 + AnzTische)) = arr2()
arr1() = Range(Cells(z * 7 + 9, 4), Cells(z * 7 + 13, 3 + AnzTische))
arr2() = Range(Cells(z * 7 + 9, 4), Cells(z * 7 + 13, 3 + AnzTische))
For zaehler = 1 To UBound(ArrIndex())
ArrIndex(zaehler) = zaehler
Cells(z * 7 + 8, zaehler + 3) = z + 2 & " Runde " & "Tisch " & zaehler
Next zaehler
Next z
If SpielerRaus > 0 Then
For zaehler = 1 To UBound(zuzahl())
Cells(zaehler + 1, 3) = zuzahl(zaehler)
Next zaehler
End If
End Sub
Leider haben wir damit jeden Teilnehmer nur einmal pro Tisch, allerdings sind die Personen immer in 3er Pärchen zusammen unterwegs, d.h. nicht durchmischt.
Hat jemand noch eine kreative Idee was zu tun?
Grüße,
markchili
