Namen nach dem Zufallsprinzip in variable Gruppen aufteilen

Home Zurück Vor

Download der Beispiel-Arbeitsmappe

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