|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Visual Basic Helper Routines Pure VB: Preventing Duplicates in a Random Number Array |
|
Posted: | Monday October 18, 1999 |
Updated: | Monday December 26, 2011 |
Applies to: | VB4-32, VB5, VB6 |
Developed with: | VB6, Windows NT4 |
OS restrictions: | None |
Author: | Rick Rothstein, Ken Ensign |
Related: | Pure VB: Generating a Random Array of Unique Numbers |
Prerequisites |
None. |
|
Although
my preference for creating a randomized array of numbers is the method
listed under Related above, there may be occasions where you want to use
brute force to create a specific random array on the fly. The code shown
here takes two values -- one representing the number of unique values
you require, and the second representing the size of the pool to draw
from, e.g. generate 12 unique numbers from 1 to 50 (as shown here). The code is copiously commented, resulting in the output shown in the illustration. You'll notice that when the third number was generated it matched an already-generated value in position 1. The code then generated a new value (38 in this case) and assigned that as the #3 item. Similarly, the code detected dupes for items 9 and 11, and regenerated new values for those.
|
BAS Module Code |
None. |
|
Form Code |
Toss a command button (Command1) and a list box (List1) onto a form, along with the following code: |
|
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() Randomize Command1.Caption = "Random Numbers w/ No Dupes" End Sub Private Sub Command1_Click() Dim nCount As Long Dim tmp As Long Dim cnt As Long Dim gotIt As Boolean Dim numDistinctValues As Long Dim numUpperValueMax As Long 'the number of unique numbers you want '(in a quiz, this might be the number 'of questions you intend to ask) numDistinctValues = 12 'the size of the pool to draw the 'unique numbers from (in a quiz, 'number of questions available) numUpperValueMax = 50 ReDim nArray(1 To numDistinctValues) List1.Clear 'seed the random number generator to 'assure a unique set of numbers each 'time the routine is run. The current 'system time is fine for this purpose. Randomize CSng(TimeValue(Time)) 'begin count to get numbers For nCount = 1 To numDistinctValues 'reset flag gotIt = False Do Until gotIt = True 'generate a number between 1 and 'numDistinctValues tmp = Int(Rnd(1) * numUpperValueMax) + 1 'if its the first number just add it 'and set the gotIt flag If nCount = 1 Then nArray(nCount) = tmp gotIt = True Else 'begin a loop that only ends 'once a new valid number is 'generated Do 'is it already in the list? For cnt = 1 To nCount 'compare the current value '(tmp) to know values If tmp = nArray(cnt) Then 'it must be there, so 'generate another number 'to try and exit the loop '---------------------------- 'DEBUG: 'show the duplicate number List1.AddItem " " & nCount & vbTab & tmp & " < this is a dupe of #" & cnt '---------------------------- 'try to generate a different number tmp = Int(Rnd(1) * numUpperValueMax) + 1 '---------------------------- 'DEBUG: 'show the new number List1.AddItem " " & nCount & vbTab & "new #" & nCount & " >" & tmp '---------------------------- 'found a match, so redo whole loop 'again with new tmp value! gotIt = False Exit For Else gotIt = True 'no match End If Next Loop Until gotIt = True End If If gotIt = True Then 'add to the array nArray(nCount) = tmp '---------------------------- 'DEBUG: 'show the added number List1.AddItem nCount & vbTab & nArray(nCount) '---------------------------- End If Loop Next End Sub |
Comments |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |