When
you need an array populated with a set of random numbers, where each number is unique (not duplicated as another array member), try this
quick routine posted to the newsgroups by Rick Rothstein.
Perfect for lotteries and card games, the following is a generalized
shuffling routine; pass an array of numbers and it will put them in random order.
Typically, to generate a random number list of
n numbers
where each number must be unique, it is necessary to generate the number then
perform a search of the already-assigned array members to
check if the new value is a
duplicate. This method, unlike those more complicated generate-and-search methods, is very fast because
once the
array is initialized (pre-filled) with numbers in sequentially order
(array element 1 is 1, element 2 is 2, element 3 is 3, and so on), the
Randomize routine never has to visit any array element more than once
because we know from the outset that each initial number is unique.
The result of the code therefore is a random shuffling the array with no
duplicate data. |
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
'assure random numbers don't
'repeat each run
Randomize
End Sub
Private Sub Command1_Click()
'Set the number of elements needed. This demo
'uses 1 to 52 to simulate a deck of cards.
Dim cnt As Long
Dim myArray(1 To 52) As Long
'lists are for info only
List1.Clear
List2.Clear
'fill the array with consecutive numbers from 1 to 52
For cnt = 1 To UBound(myArray)
myArray(cnt) = cnt
'debug/info only - not needed for routine
List1.AddItem cnt & vbTab & myArray(cnt)
Next
'randomize (suffle) the array values
RandomizeArray myArray
'debug/info only - not needed for routine
For cnt = 1 To UBound(myArray)
List2.AddItem cnt & vbTab & myArray(cnt)
Next
End Sub
Private Sub RandomizeArray(ArrayIn As Variant)
Dim cnt As Long
Dim RandomIndex As Long
Dim tmp As Variant
'only if an array was passed
If VarType(ArrayIn) >= vbArray Then
'loop through the array elements in reverse
For cnt = UBound(ArrayIn) To LBound(ArrayIn) Step -1
'select a random array index
RandomIndex = Int((cnt - LBound(ArrayIn) + 1) * _
Rnd + LBound(ArrayIn))
'cnt represents one array member
'index, and RandomIndex represents
'another, so swap the data held in
'myarray(cnt) with that in myarray(RandomIndex)
tmp = ArrayIn(RandomIndex)
ArrayIn(RandomIndex) = ArrayIn(cnt)
ArrayIn(cnt) = tmp
Next
Else
'The passed argument was not an
'array; error handler goes here
End If
End Sub
Private Sub List1_Scroll()
'if List2 is scrolled, keep List1 in sync
List2.TopIndex = List1.TopIndex
End Sub
Private Sub List2_Scroll()
'if List1 is scrolled, keep List2 in sync
List1.TopIndex = List2.TopIndex
End Sub |