Newsgroup: it.comp.appl.access
Titolo: Numeri random univoci

Salve a tutti,
avendo un range da 1 a 90000 dovrei fare un'estrazione casuale
di circa 2000 numeri, ma devono essere unici.
Mi sapete dare una dritta in vba.
 
Grazie
 
-- 
O no ?
 
WS


dal webbe con gugle
 
Public Function RandLotto2(Bottom As Double, Top As Double, _
                           Amount As Double) As String
 
 
 
     Dim iArr As Variant
     Dim i As Double
     Dim j As Double
     Dim r As Double
     Dim Temp As Double
 
     ReDim iArr(Bottom To Top)
     For i = Bottom To Top
         iArr(i) = i
     Next i
 
     For i = Top To Bottom + 1 Step -1
         Randomize
         r = Int(Rnd() * (i - Bottom + 1)) + Bottom
         Temp = iArr(r)
         iArr(r) = iArr(i)
         iArr(i) = Temp
     Next i
 
     For i = Bottom To Amount
         For j = i + 1 To Amount
             If iArr(i) > iArr(j) Then
                 Temp = iArr(i)
                 iArr(i) = iArr(j)
                 iArr(j) = Temp
             End If
         Next j
     Next i
 
     For i = Bottom To Bottom + Amount - 1
         RandLotto2 = iArr(i)
          Debug.Print RandLotto2
     Next i
 
 
 
End Function
 
Sub test()
Dim x As Variant
x = RandLotto2(1, 90000, 2000)
End Sub


Option Compare Database
Option Explicit
 
'--------------------------------------------------------------------------
' AUTORE : LOKAR (dal NG I.C.L.V.B.)
'--------------------------------------------------------------------------
 
Private Sub Form_Load()
    Dim c As Collection
    Dim v As Variant
    Dim n As Integer
    Set c = Draw(10000, 20000, 100)
    n = 1
    For Each v In c
        Debug.Print n & " - " & v
        n = n + 1
    Next v
End Sub
 
'--------------------------------------------------------------------------
' Questo è il cuore della Funzione, sfrutta una Collection
' d'appoggio che riempie con l'intervallo passato
' quindi recupera in modo Random gli Items eliminandoli
' ogni volta per evitare possibili Doppioni
'--------------------------------------------------------------------------
Private Function Draw(ByVal MinValue As Long, _
                      ByVal MaxValue As Long, _
                      ByVal Draws As Long) As Collection
    Dim i As Long
    Dim j As Long
    Dim Numbers As Collection
    Dim Drawn As Collection
 
 
    Set Numbers = New Collection
    Set Drawn = New Collection
 
 
    For i = MinValue To MaxValue
        Call Numbers.Add(i)
    Next i
 
    Call Randomize(time())
 
    For j = 1 To Draws
        i = CLng(Rnd() * (Numbers.Count - 1) + 1)
        Call Drawn.Add(Numbers.Item(i))
        Call Numbers.Remove(i)
    Next j
    Set Numbers = Nothing
    Set Draw = Drawn
    Set Drawn = Nothing
End Function
 
Saluti
@Alex

 Mi sapete dare una dritta in vba.
 
Ed io fui terzo fra cotanto senno:
=======================================
Private Sub Command80_Click()
Dim k As Long, RandomValues As New Collection, X As Long
Dim LowerBound As Long, UpperBound As Long, Numero As Long
 
'---  Definizioni  ----
LowerBound = 1
UpperBound = 90000
Numero = 2000
'----------------------
 
Do Until k = Numero
    X = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
    On Error GoTo Duplication
    RandomValues.Add X, CStr(X)
    On Error GoTo 0
    k = k + 1
Continua:
Loop
 
For k = 1 To RandomValues.Count
    MsgBox RandomValues(k)
Next
 
Brexit:
    Exit Sub
 
Duplication:
    On Error GoTo 0
    Resume Continua
 
End Sub
=====================================
 
Bruno

 
http://www.avg.com
 
 
Grazie a tutti
