PDA

View Full Version : Random Combination



RobertBC
07-07-2008, 12:06 PM
How can i generate a combination of 5 numbers (each number list per column) in range of 0 to 9 and the number generated is list down row by row.

example
1 2 3 4 5
1 2 3 4 6
..
5 6 7 8 9
5 6 7 8 0
..
3 8 5 4 2
7 8 1 5 4
.. and so on?

but how can i ommited the combination like this.

1 2 3 4 5
is the same as
1 2 3 5 4
or
5 4 1 2 3


tnx :friends:

mikerickson
07-07-2008, 12:38 PM
Something like this might work for you

Sub test()
Dim oneChoiceArray As Variant, overflow As Boolean
Dim writeRow As Long, writeThis As String, i As Long
Dim writeArray As Variant

oneChoiceArray = Array(True, True, True, True, True, False, False, False, False, False)
Do
writeRow = writeRow + 1
writeThis = vbNullString
For i = LBound(oneChoiceArray) To UBound(oneChoiceArray)
If oneChoiceArray(i) Then
writeThis = writeThis & " " & CStr(i)
End If
Next i
writeArray = Split(Mid(writeThis, 2))
Cells(writeRow, 1).Resize(1, UBound(writeArray) + 1) = writeArray
oneChoiceArray = nextChoiceArray(oneChoiceArray, overflow)
Loop Until overflow
End Sub

Function nextChoiceArray(oldChoiceArray As Variant, Optional ByRef overflow As Boolean) As Variant
Dim workingArray As Variant
Dim state As Boolean, i As Long, pointer As Long
workingArray = oldChoiceArray
pointer = LBound(workingArray)
For i = LBound(workingArray) To UBound(workingArray)
If state Then
If workingArray(i) Then
workingArray(i) = False
workingArray(pointer) = True
pointer = pointer + 1
Else
workingArray(i) = True
Exit For
End If
Else
state = workingArray(i)
workingArray(i) = False
End If
Next i
overflow = (i > UBound(workingArray))
If overflow Then workingArray(pointer) = True
nextChoiceArray = workingArray
End Function

david000
07-08-2008, 08:37 AM
Dave Hawley of OzGrid made a brilliant custom function that is very close to what you illustrate.

try it like this: =No_Repeat_Random_Numbers(0,9,5)



Function No_Repeat_Random_Numbers(Bottom As Integer, Top As Integer, Amount As Integer)
'
' No_Repeat_Random_Numbers Macro
' Will generate x unique random numbers between any 2 numbers you specify.
'

'
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
No_Repeat_Random_Numbers = No_Repeat_Random_Numbers & " " & iArr(i)
Next i
No_Repeat_Random_Numbers = Trim(No_Repeat_Random_Numbers)

End Function