HERBERS Excel-Forum - die Beispiele

Thema: Namen nach dem Zufallsprinzip auswählen und eintragen

Home

Gruppe

Allgemein

Problem

Aus den Spalten A:B sollen nach dem Zufallsprinzip Namen ausgewählt und in Spalten C:D eingetragen werden.

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: basMain

Sub Zufall()
   Dim rngAct As Range, rngPart As Range, rngFind As Range
   Dim iCol As Integer, iTmp As Integer
   Dim iRow As Integer, iCount As Integer
   Application.ScreenUpdating = False
   Randomize
   If IsEmpty(Cells(1, 3)) Then
      iRow = 1
   Else
      iRow = Cells(Rows.Count, 3).End(xlUp).Row + 1
   End If
   iCount = WorksheetFunction.CountA(Columns(1))
   For iCol = 1 To 2
      Set rngPart = Range(Cells(1, iCol + 2), Cells(iCount, iCol + 2))
      iTmp = Int((iCount * Rnd) + 1)
      Set rngFind = rngPart.Find(Cells(iTmp, iCol), _
         lookat:=xlWhole, LookIn:=xlValues)
      While Not rngFind Is Nothing
         iTmp = Int((iCount * Rnd) + 1)
         Set rngFind = rngPart.Find(Cells(iTmp, iCol), _
            lookat:=xlWhole, LookIn:=xlValues)
      Wend
      Cells(iRow, iCol + 2) = Cells(iTmp, iCol)
   Next iCol
End Sub