Bitte um Bewertung - Uniq Zufallszahl

Public Sub ZUFALLSZAHL() Dim i As Integer Dim x As Integer Dim iRnd As Integer Dim colSpeicher As New Collection Dim Eintrag As New clsKlassenmodul Dim IsUnique As Boolean Dim iFirstRnd As Integer Dim iLastRnd As Integer Dim iMaxEintrag As Integer Dim wks As Worksheet Set wks = Tabelle1 Application.ScreenUpdating = False 'Anzahl der Einträge in der Collection iMaxEintrag = 35 '# Bereich der Zufallszahlen 'Erste Zufallszahl iFirstRnd = 2 'Letzte Zufallszahl iLastRnd = 36 '# Zufallszahlen in eine Collection schreiben '# Vorteil: muss nicht dimensioniert werden '# Nachteil: langsamer als Array bei vielen Einträgen 'Schleife Starten um Collection zu befüllen. For i = 1 To iMaxEintrag 'Bei jedem Durchlauf muss eine neues Klassenmodul erstellt werden 'um es als Item in der Collection zu speichern. Set Eintrag = New clsKlassenmodul 'Sprungmarke NEUE_ZAHL: 'Zufallszahl generieren lassen. iRnd = WorksheetFunction.RandBetween(iFirstRnd, iLastRnd) 'Die Erste Zahl direkt in die Collection übernehmen. If i

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hey Tobias,
danke schonmal für dein Antwort.


Warum erstellst du eine Klasse und gibst an die Collection nicht nur den Integer weiter?

Im Grunde benötige ich gefühlt ständig Zufallszahlen um irgendwelche wilden Listen zu erstellen.
Die Klasse habe ich aus Gründen der Standardisierung ertsellt.
Somit kann ich immer direkt komplette "Datenpakete zusammenstellen", mit z.B. einer zufälligen Zeilennummer.
Die Klasse besteht meist aus "Name", "Vorname", "Einheit", "Diensttuer", "Zeilennummer" oder ähnlich.


Wie wäre es wenn du zuerst Collection mit deinem Zahlbereich füllst und anschließend einfach nur die Werte in zufälliger Reihenfolge aus dieser Collection entnimmst?

Müsste ich dann nicht auch wieder vergleichen welche Werte ich schon entnommen habe, um dort keine Doppelung zu haben? Wäre doch fast das gleich, nur andersrum.


Wieso berechnest du iMaxEintrag nicht?

iMaxEintrag ist nur hier händisch denifiert. Alle Variablen wie iMaxEintrag, iFirstRnd & iLastRnd können später automatisch gesetzt werden. Daher auch die Variablendeklaration :)


Ansonsten hatte ich schon häufiger Probleme wenn man Worksheets mit Set zuweist und hinterher nicht ordentlich mit
set wks = nothing
die Variablen wieder freigibt.

Das werde ich mir zu Herzen nehmen und umsetzen, da ich was das Freigeben von Variablen angeht vielleicht etwas schlampig bin ^^
Besten Gruß
Konstantin

Wie wäre es wenn du zuerst Collection mit deinem Zahlbereich füllst und anschließend einfach nur die Werte in zufälliger Reihenfolge aus dieser Collection entnimmst? Müsste ich dann nicht auch wieder vergleichen welche Werte ich schon entnommen habe, um dort keine Doppelung zu haben? Wäre doch fast das gleich, nur andersrum.

Private Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long Sub Zufallszahlen() Dim iUnten As Integer Dim iOben As Integer Dim iRnd As Integer Dim Werte As New Collection Dim Ergebnis As String Dim timer As Long timer = GetTickCount iUnten = 2 iOben = 25000 'Collection füllen For i = iUnten To iOben Werte.Add i Next i 'Collection leeren Do While Werte.Count > 0 iRnd = WorksheetFunction.RandBetween(1, Werte.Count) Ergebnis = Ergebnis & " | " & Werte(iRnd) Werte.Remove iRnd Loop Debug.Print GetTickCount - timer & " ms Laufzeit" End Sub

Hallo Rudi,
auch dir danke für die Zeit und Antwort auf meine Bitte.


wenn du ein Dictionary-Objekt statt einer Collection benutzt, kannst du dir die Prüfung auf Existenz sparen.

Habt direkt mal die Microsoft suche benutzt.
https://docs.microsoft.com/de-de/office/vba/language/reference/user-interface-help/dictionary-object
Es erschließt sich mir nur noch nicht so ganz wie ich hiermit die Prüfung auf Existenz umgehen kann.
Das jedes Element in dem Dictionary einen Uniq-Key bekommt, ok.
Aber wie kann ich dann verhindern das nicht evtl. zwei Einträge mit unterschiedlichem Key den gleichen Wert besitzen?
Auf meine Beispielmappe gemünzt:
Hier weise ich jedem Klassenmodul einen Namen und eine Zeilennummer(Zufallszahl) zu.
Die Zufallszahl nicht doppelt da sonst Einträge überschrieben werden würden.
Dictionary ist da grade ein Böhmisches Dorf für mich -.-
Besten Gruß
Konstantin

Sub Zufall() Dim oDic As Object, oObj Dim arrA(), arrB() Dim i As Integer, iCount As Integer Const iFirst As Integer = 1 'erste Const iLast As Integer = 1000 'letzte iCount = 200 'Anzahl Set oDic = CreateObject("scripting.dictionary") iCount = Application.Min(iCount, iLast - iFirst + 1) For i = iFirst To iLast Randomize oDic(i) = Rnd Next ReDim arrA(1 To oDic.Count, 1 To 2) i = 0 For Each oObj In oDic i = i + 1 arrA(i, 1) = oDic(oObj) arrA(i, 2) = oObj Next oObj Call QuickSort2(arrA) ReDim arrB(1 To iCount, 1 To 1) For i = 1 To iCount arrB(i, 1) = arrA(i, 2) Next Cells(1, 1).Resize(iCount, 1) = arrB End Sub

Sub QuickSort2(ByRef DasArray, Optional ErsteZeile, Optional LetzteZeile) On Error Resume Next Dim UnterGrenze As Long, OberGrenze As Long, aktuelleSpalte As Long Dim AktuellerWert, GemerkterWert As Variant If IsMissing(ErsteZeile) Then ErsteZeile = LBound(DasArray) End If If IsMissing(LetzteZeile) Then LetzteZeile = UBound(DasArray) End If UnterGrenze = ErsteZeile OberGrenze = LetzteZeile AktuellerWert = DasArray((ErsteZeile + LetzteZeile) / 2, 1) Do While (UnterGrenze AktuellerWert And OberGrenze > ErsteZeile) OberGrenze = OberGrenze - 1 Loop If (UnterGrenze ErsteZeile) Then Call QuickSort2(DasArray, ErsteZeile, OberGrenze) If (UnterGrenze

Sub Zufall() Dim arrA() Dim i As Integer, iCount As Integer Const iFirst As Integer = 1 'erste Const iLast As Integer = 25000 'letzte iCount = 200 'Anzahl iCount = Application.Min(iCount, iLast - iFirst + 1) ReDim arrA(iFirst To iLast, 1 To 2) For i = iFirst To iLast arrA(i, 1) = Rnd arrA(i, 2) = i Next Call QuickSort2(arrA) Cells(1, 1).Resize(iCount, 2) = arrA Columns(1).Delete End Sub

Dim C As Collection Sub Coll_init() Dim i Const iFirst = 2 Const iLast = 36 Set C = New Collection For i = iFirst To iLast C.Add CStr(i) Next End Sub Sub Verwende() Dim x Do While C.Count > 0 x = WorksheetFunction.RandBetween(1, C.Count) Debug.Print C(x) C.Remove x Loop End Sub

Beliebteste Forumthreads (12 Monate)

Bitte um Bewertung - Uniq Zufallszahl

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread