mmylius
asked on
Random Number Generator to Equal a Sum
Hello Experts!
I am trying to create a VB code in 2010 that will take a sum (say 40), and randomly generate a set of random numbers (say 6 total numbers) that will equal that sum.
For example, if I ran it one time, it would create:
8
7
5
9
6
5
and when I run it again, it would create:
7
10
4
8
3
8
I thank you all in advance!
I am trying to create a VB code in 2010 that will take a sum (say 40), and randomly generate a set of random numbers (say 6 total numbers) that will equal that sum.
For example, if I ran it one time, it would create:
8
7
5
9
6
5
and when I run it again, it would create:
7
10
4
8
3
8
I thank you all in advance!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
nutsch....nice one!
Give this test a try.
Sub Test()
MsgBox DoRand(30)
End Sub
Function DoRand(intNumber)
Randomize
intRemain = intNumber
strList = ""
While intRemain > 0
intNext = Int((intRemain * Rnd) + 1)
intRemain = intRemain - intNext
If strList = "" Then
strList = intNext
Else
strList = strList & "," & intNext
End If
Wend
DoRand = strList
End Function
~bp
That is a pretty cool answer by nutsch!
Here's another approach:
Here's another approach:
Option Explicit
Private Sub CommandButton1_Click()
Dim randomSet As Variant
randomSet = RandomSumSet(40, 6)
' ...do something with the set...
ListBox1.Clear
Dim i As Integer
For i = LBound(randomSet) To UBound(randomSet)
ListBox1.AddItem randomSet(i)
Next
End Sub
Private Function RandomSumSet(ByVal sum As Integer, ByVal numDigits As Integer) As Variant
Static Seeded As Boolean
If Not Seeded Then
Seeded = True
Randomize
End If
Dim numbers() As Integer
ReDim numbers(numDigits - 1)
Dim startValue As Integer
startValue = sum \ numDigits ' Integer Division
Dim i As Integer
For i = 1 To numDigits
numbers(i - 1) = startValue
Next
If numDigits * startValue <> sum Then
numbers(numDigits - 1) = sum - ((numDigits - 1) * startValue)
End If
Dim index As Integer
Dim j As Integer
For j = 1 To 100
For i = 1 To numDigits
Do
index = Int((numDigits - 1 + 1) * Rnd + 1)
Loop While index = i
If Rnd >= 0.5 Then
If numbers(i - 1) > 1 Then
numbers(i - 1) = numbers(i - 1) - 1
numbers(index - 1) = numbers(index - 1) + 1
End If
Else
If numbers(index - 1) > 1 Then
numbers(index - 1) = numbers(index - 1) - 1
numbers(i - 1) = numbers(i - 1) + 1
End If
End If
Next
Next j
RandomSumSet = numbers
End Function
Cells A1:A6 contain =Randbetween(1,10) and A7 contains Sum(A1:A6). Code below and in the attached file.
Patrick
Patrick
Sub rnandomnos()
While [A7] <> 40
Calculate
Wend
End Sub
To get a new set of numbers press F9 and then press the button
code below is in the attached file.
Patrick
randNos.xls
ASKER
nutsch, thank you very much, that was exactly what I was looking for!
ASKER
...going to fast.. thank you to everyone who answered also!
This is VBScript, but you might be able to translate it to .NET.
Regards,
Rob.
Open in new window