Gruppe
Allgemein
Problem
Aus den Spalten A:B sollen nach dem Zufallsprinzip Namen ausgewählt und in Spalten C:D eingetragen werden.
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