Thema: Namen nach dem Zufallsprinzip in variable Gruppen aufteilen

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

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Zufall