pincodes

[ruva]

beste excelliefhebbers,

het volgende

ik moet regelmatig pincodes verzinnen 5 cijferig, jullie begrijpen dat dat vrij lastig is, zeker als het om grote aantallen gaat
ik dacht zelf aan een button, wanneer je deze aanklikt dat je dan een andere code krijgt, uiteraard mag een pincode niet 2 maal uitgegeven worden.

wie kan mij helpen

Ik hoor het graag,

 

[aalalex]

klinkt dat alsof je een programmatje wilt schrijven die random cijfer combinaties geeft? Die alle gebruikte combinaties opslaat en niet meer gebruikt?

 

[ruva]

Klopt, dat is wat ik bedoel

 

[Petervdberge]

http://random-number-generator-to-create-random.smartcode.com/info.html

Dit is wat jij nodig hebt.

 

[JanEnEm]

Zie ook: http://www.random.org/

 

[aalalex]

of je download een progje... ;D

maar er eentje schrijven is leuker..

 

[RaymondC]

Ik bewaar nogal wat codes, en deze is er eentje van (auteur weet ik niet).

Function RandLotto(Bottom As Integer, Top As Integer, _
                    Amount As Integer) As String
    Dim iArr As Variant
    Dim i As Integer
    Dim r As Integer
    Dim temp As Integer
    
    Application.Volatile
    
    ReDim iArr(Bottom To Top)
    For i = Bottom To Top
        iArr(i) = i
    Next i
    For i = Top To Bottom + 1 Step -1
        r = Int(Rnd() * (i - Bottom + 1)) + Bottom
        temp = iArr(r)
        iArr(r) = iArr(i)
        iArr(i) = temp
    Next i
    For i = Bottom To Bottom + Amount - 1
        RandLotto = RandLotto & " " & iArr(i)
    Next i
    RandLotto = Trim(RandLotto)
End Function

'Unique random numbers

'With the user defined function below you can create a liste of unique random numbers:

Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant
' creates an array with NumCount unique long random numbers in the range LLimit - ULimit (including)
Dim RandColl As Collection, i As Long, varTemp() As Long
    UniqueRandomNumbers = False
    If NumCount < 1 Then Exit Function
    If LLimit > ULimit Then Exit Function
    If NumCount > (ULimit - LLimit + 1) Then Exit Function
    Set RandColl = New Collection
    Randomize
    Do
        On Error Resume Next
        i = CLng(Rnd * (ULimit - LLimit) + LLimit)
        RandColl.Add i, CStr(i)
        On Error GoTo 0
    Loop Until RandColl.Count = NumCount
    ReDim varTemp(1 To NumCount)
    For i = 1 To NumCount
        varTemp(i) = RandColl(i)
    Next i
    Set RandColl = Nothing
    UniqueRandomNumbers = varTemp
    Erase varTemp
End Function

' example use:
Sub TestUniqueRandomNumbers()
Dim varrRandomNumberList As Variant
    varrRandomNumberList = UniqueRandomNumbers(Range("D1"), Range("D2"), Range("D3"))
    'D1 will.getallen, kleinste getal D2, grootste D3
    Range(Cells(1, 1), Cells(Range("D1"), 1)).Value = _
        Application.Transpose(varrRandomNumberList)
        'eerste cel A1, van A1 tot A48
End Sub