Gruppe
Allgemein
Bereich
Zufall
Thema
Namen nach dem Zufallsprinzip in variable Gruppen aufteilen
Problem
Die in Spalte A stehenden Namen sollen nach dem Zufallsprinzip in Gruppen aufgeteilt werden, wobei die Gruppenanzahl variabel ist und sich über eine InputBox abfragen lassen soll.
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: basMain
Sub ZufallsNamen()
Dim rng As Range
Dim var As Variant
Dim iRowL As Integer, iCell As Integer, iCol As Integer
Dim iRow As Integer, iAct As Integer
Dim sName As String
Columns("B:IV").ClearContents
var = Application.InputBox( _
prompt:="Anzahl Gruppen:", _
Default:=6, Type:=1)
If var = "" Then Exit Sub
If Not IsNumeric(var) Then Exit Sub
For iCol = 1 To CInt(var)
Cells(2, iCol + 2) = "Gruppe" & CStr(iCol)
Next iCol
Randomize
iRowL = Range("A1").CurrentRegion.Rows.Count
iRow = 3
iCol = 3
For iCell = 1 To iRowL
iAct = Int((iRowL * Rnd) + 1)
sName = Cells(iAct, 1).Value
Set rng = Range("C2").CurrentRegion.Find( _
what:=sName, lookat:=xlWhole, LookIn:=xlValues)
Do While Not rng Is Nothing
iAct = Int((iRowL * Rnd) + 1)
sName = Cells(iAct, 1).Value
Set rng = Range("C2").CurrentRegion.Find( _
what:=sName, lookat:=xlWhole, LookIn:=xlValues)
Loop
Cells(iRow, iCol) = sName
iCol = iCol + 1
If IsEmpty(Cells(2, iCol)) Then
iRow = iRow + 1
iCol = 3
End If
Next iCell
End Sub