Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 11:45:34
Feld im SAP auslesen
19.04.2024 10:59:29
Datei Auswählen und öffnen
19.04.2024 10:46:47
Bestimmte Zellen aus dynamischer Liste zurückgeben
19.04.2024 10:39:36
Schaltfläche auf einem Tabellenblatt NICHT mit abspeichern
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1796to1800
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1796to1800
1796to1800
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zufallslosung

Zufallslosung
30.11.2020 16:42:44
Udo
Habe eine Datei die zufällig lost und in Gruppen aufteilt.
Die Datei tut was sie soll.
Meine Frage was muss ich am Code verändern das erstens keine Abfrage mehr kommt wieviele Gruppen
gelost werden sollen
und was muss ich am code verändern das z.B immer in 4 Gruppen gelost wird ohne Abfrage
Danke LG
https://www.herber.de/bbs/user/141957.xls

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zufallslosung
30.11.2020 16:48:34
Herbert_Grom
Hallo Udo,
das ist ja eine schöne alte Datei von Hans Herber! Probiers mal damit:
Sub ZufallsNamen()
Dim rng As Range
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
For iCol = 1 To 4
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
Servus
Anzeige
AW: Zufallslosung
30.11.2020 16:57:46
Udo
Perfekt DANKE
AW: Zufallslosung
30.11.2020 17:01:37
Herbert_Grom
Hallo Udo,
gerne geschehen und danke für die Rückmeldung!
Wusstest du, dass das eine Datei von HWH ist?
Servus
steht doch in den Informationen ;-) owT
30.11.2020 17:52:57
Matthias
AW: steht doch in den Informationen ;-) owT
30.11.2020 17:56:05
Herbert_Grom
Hallo Matthias,
klar steht das dort. Aber die kennen viele ja gar nicht!
Servus

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige