AW: Zufalls-Verteilung
26.08.2014 10:53:26
fcs
Hallo Udo,
hier mal ein Ansatz per Makro. Die am jeweiligen Termin aktiven Teilnehmer werden in den Spalten E bis L eingetragen. An jedem 2. Termin werden die am vorherigen Termin nicht aktiven Teilnehmer eingetragen.
An jedem Termin die 4er-Gruppen per Zufal zusammenzustellen kann zu extrem Unterschieden bei der Anzahl der Teilnahmen führen.
Gruß
Franz
Sub Teams_kombinieren()
'8 Teilnehmer zu zufälligen 4er-Gruppen zusammenstellen
Dim varNumber As Single
Dim objCol As Collection, intCol As Integer
Dim varZufall
Dim Zeile As Long, Spalte As Long
Const ZeileNamen As Long = 1 'Zeile mit den Namen
Const Zeile1 As Long = 2 'Zeile mit 1. Termin
Const SpaName1 As Long = 5 'Spalte mit 1. Namen
Const AnzNamen As Long = 8 'Anzahl Namen
Dim wks As Worksheet
Set wks = ActiveSheet
With wks
.Range("E2:L34").ClearContents
For Zeile = Zeile1 To 34 '34 = Zeile mit letztem Termin
If Zeile Mod 2 = IIf(Zeile1 Mod 2 = 0, 1, 0) Then
'in der Vorwoche nicht gesetzte Teilnehmer setzen
For Spalte = SpaName1 To SpaName1 + AnzNamen - 1 'E bis L
If .Cells(Zeile - 1, Spalte) = "" Then
.Cells(Zeile, Spalte) = .Cells(ZeileNamen, Spalte)
End If
Next
Else
'Collection mit Anzahlnamen erstellen
Set objCol = New Collection
For intCol = 1 To AnzNamen
objCol.Add Item:=intCol
Next
'4 Name zufällig auswählen
For intCol = AnzNamen To 5 Step -1
varNumber = Rnd(Time)
varZufall = Int((intCol - 1 + 1) * varNumber + 1)
Randomize varNumber
.Cells(Zeile, SpaName1 - 1 + objCol(varZufall)) = _
.Cells(ZeileNamen, SpaName1 - 1 + objCol(varZufall))
'gewählte Nummer aus Collection löschen
objCol.Remove (varZufall)
Next
End If
Next Zeile
End With
End Sub