X Unique Randomize Numbers-CodePudding

i need a little bit help. Is it possible to fill a list with random numbers and to check this list before each loop to see if the number already exists?

I think im on the wrong way with my VBA.

Sub Zufallszahlen()

Dim Rng As Range

Max = 6
Min = 1
Anzahl = 4
counter = 0
innercounter = 0
SZeile = 2
AWert = "X"

Range("C:C").Clear

Do
    counter = counter   1
    ZZahl = Int((Max * Rnd)   Min)
    innercounter = 0
    
    Do
        innercounter = innercounter   1
            If Cells(innercounter, 2) = ZZahl Then
            ZZahl = Int((Max * Rnd)   Min)
        
        Else
    Loop Until innercounter = Anzahl
        
    ' Cells(counter, 1).Value = counter
    Cells(counter, 2).Value = ZZahl
    Cells(ZZahl, 3).Value = AWert
    
Loop Until counter = Anzahl

Range("B:B").Clear
End Sub

CodePudding user response：

Use an array to check if random number has already been chosen. Repeat until a vacant array position is found.

Sub Zufallszahlen()
    
    Const MaxN = 6
    Const MinN = 1
    Const Anzahl = 4
    Const Awert = "X"
    
    Dim ar, n As Long, r As Long
    n = MaxN - MinN   1
    If n < Anzahl Then
        MsgBox "Min to Max range must be >= " & Anzahl
        Exit Sub
    End If
    
    ReDim ar(1 To n, 1 To 1)
    
    For i = 1 To Anzahl
        Do
            r = 1   Int(n * Rnd())
        Loop Until ar(r, 1) = ""
        ar(r, 1) = Awert
    Next
    Range("C:C").Clear
    Range("C" & MinN).Resize(n) = ar
    
End Sub

CodePudding user response：

You can use the Scripting.Dictionary object to check.

Given it's a "Dictionary", it requires that all keys are unique.

This is a crude implementation demonstrating the random filling of that dictionary with all numbers between 50 and 100.

Public Sub DoRandomize()
    Dim objUnique As Object, i As Long, lngRandom As Long
    Dim lngMin As Long, lngMax As Long, dblRandom As Double
    
    lngMin = 50: lngMax = 100
    
    Set objUnique = CreateObject("Scripting.Dictionary")
    
    Do While objUnique.Count <> (lngMax - lngMin)   1
        Randomize objUnique.Count
        lngRandom = (Rnd(objUnique.Count) * (lngMax - lngMin))   lngMin
        
        If Not objUnique.exists(lngRandom) Then
            Debug.Print "Adding ......... " & lngRandom
            objUnique.Add lngRandom, vbNull
        Else
            Debug.Print "Already used ... " & lngRandom
        End If
    Loop
End Sub

... you'd just need to pull out the relevant parts for your implementation but you can paste that code into your project, run it and see it work for yourself.