Thema: Vorgegebene Anzahl Artikel nach dem Zufallsprinzip auswählen

StandardModule: Modul1

Sub ArtikelSchreiben()
   Dim rngA As Range, rngB As Range
   Dim iRowCount As Integer, iColCount As Integer
   Dim iCol As Integer, iRow As Integer, iRandomize As Integer
   Randomize
   With Worksheets("Listen")
      iRowCount = .Range("A1").CurrentRegion.Rows.Count
      iColCount = .Range("A1").CurrentRegion.Columns.Count
      Set rngA = .Range(.Cells(2, 1), .Cells(iRowCount, iColCount))
   End With
   Set rngB = Range(Cells(2, 1), Cells(Range("Count").Value + 1, iColCount))
   Range(Cells(2, 1), Cells(65536, iColCount)).ClearContents
   rngB.ClearContents
   For iCol = 1 To iColCount
      For iRow = 1 To Range("Count").Value
         iRandomize = Int((iRowCount * Rnd) + 1)
         Do Until WorksheetFunction.CountIf(rngB.Columns(iCol), rngB.Cells(iRow, iCol).Value) = 1
            rngB.Cells(iRow, iCol).Value = rngA.Cells(iRandomize, iCol).Value
            iRandomize = Int((iRowCount * Rnd) + 1)
         Loop
      Next iRow
   Next iCol
End Sub

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