Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
824to828
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
824to828
824to828
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zufallszahl ohne Wiederholung (große Datenmenge)

Zufallszahl ohne Wiederholung (große Datenmenge)
04.12.2006 13:23:44
Thomas_H
Hallo an Alle!
Ich habe mal wieder in meiner Firma eine Aufgabe gestellt bekommen die ich ohne eure Hilfe nicht lösen kann. Folgendes Problem:
Wir haben einen Verlosung an der ca. 900 Personen teilnehmen. Auf meiner Liste steht jeder Name mit der Anzahl der erworbenen Lose (ca. 35.000)
Ich möchte nun eine Zufallszahl für jede Zeile (ohne doppelten Wert) zuweisen.
Ich verwende zwar ein Makro dafür aber das funktioniert leider nicht so richtig.
Habt ihr eine Idee, was ich machen könnte.
Vielen Dank für die Unterstützung.
Thomas H.
Ps: anbei mein derzeitiger Code

Sub Zufall()
Application.ScreenUpdating = False
Dim ds As Worksheet, es As Worksheet
Dim x As Single, y As Single, z As Single
Dim i As Variant, j As Variant
Dim Weiter_ermitteln As Boolean
Const Anzahl = 25114
Dim arrZufall(1 To Anzahl) As Variant
Set ds = Sheets("Tabelle1")
Set es = Sheets("Tabelle2")
arrZufall(1) = Int((Anzahl * Rnd) + 1)
For i = 1 To Anzahl
Do
Weiter_ermitteln = False
arrZufall(i) = Int((Anzahl * Rnd) + 1)
For j = 1 To i - 1
If arrZufall(j) = arrZufall(i) Then Weiter_ermitteln = True
Next
Loop Until Not Weiter_ermitteln
Next
For i = 1 To Anzahl
es.Cells(i, 1) = arrZufall(i)
Next
z = 1
For x = 2 To ds.UsedRange.Rows.Count
For y = 1 To ds.Cells(x, 2).Value
es.Cells(z, 2) = ds.Cells(x, 1)
z = z + 1
Next y
Next x
Application.ScreenUpdating = True
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Zufallszahl ohne Wiederholung (große Datenmenge)
04.12.2006 13:51:35
haw
Hallo Thomas,
hier eine Möglichkeit

Sub ZufallsZahlen()
Dim c As Range, BereichA As Range, g As Range, Bereich As Range
Dim i%, tmp%
Const Anzahl = 25114
Set ws = ThisWorkbook.Worksheets(1)
Set Bereich = ws.Range("A1:A" & Anzahl)
For Each c In Bereich
tmp = Int((Anzahl * Rnd) + 1)
Set g = Bereich.Find(tmp, lookat:=xlWhole)
Do While Not g Is Nothing
tmp = Int((Anzahl * Rnd) + 1)
Set g = Bereich.Find(tmp, lookat:=xlWhole)
Loop
c.Value = tmp
Next c
End Sub

Gruß
Heinz
Anzeige
AW: Zufallszahl ohne Wiederholung (große Datenmeng
04.12.2006 13:57:07
Erich
Hallo Thomas,
noch 'ne Lösung:
Option Explicit
Sub Zufallsliste4()                    ' Zahlen 1 bis Anzahl ohne Wiederholungen
Const Anzahl = 25114
Dim bb As Range
Set bb = Range(Cells(1, 1), Cells(Anzahl, 1))
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'                                Zeilennr. und Zufallszahlen eintragen
With bb
.FormulaLocal = "=ZEILE()"
.Value = .Value
End With
Randomize
With bb.Offset(0, 1)
.FormulaLocal = "=ZUFALLSZAHL()"
.Value = .Value
End With
'                                Sort nach Spalte mit Zufallszahlen
Columns("A:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1
'                                Spalte mit Zufallszahlen löschen
Columns(2).Delete
Cells(1, 1).Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Zufallszahl ohne Wiederholung (große Datenmenge)
04.12.2006 14:34:13
ingUR
Hallo, Thomas,
eigentlich habe ich nicht herauslesen können, was denn da nicht so richtg funktioniert.
Ich gehe davon aus, dass es die Zufallszahlenzuweisung ist. Hier kann, neben den anderen Vorschlägen, auch mit einem zusätzlichen Indexfeld als "Abhakliste" der gezogenen Nummern gearbeitet werden (Feld: arrIsFree). Sobald ein wert dezogen ist, wird er in der Liste auf -1 gesetzt und scheidet so für den eintrag bei erneuter Ziehung aus:
    Dim arrZufall(1 To Anzahl) As Variant
Dim arrIsFree(1 To Anzahl) As Integer
Randomize
For i = 1 To Anzahl
Do
iLosNr = Int((Anzahl * Rnd) + 1)
If arrIsFree(iLosNr) > -1 Then
arrZufall(i) = iLosNr
arrIsFree(iLosNr) = -1
End If
Loop Until arrZufall(i) > 0
Next

Gruß,
Uwe
Anzeige
Danke :-)
04.12.2006 14:43:54
Thomas_H
Hallo!
Danke für eure Unterstützung.
Nachdem die letzte Variante von Uwe am schnellsten funktioniert, habe ich mich für seine Entschieden. Danke nochmals für eure Hilfe.
Thomas H.

166 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige