Quote: Originally posted by JADELottery on Feb 10, 2017
Ok, OK, OOO-KAAAAYY.
We worked out a Disimulate 2D function.
We're going to post just the basic stuff right now: function usage and function code.
We are not in a place were we can access our server.
So, we will post an Excel of these examples later.
Here'goes.
The basic format for the new function is:
And, is applied to a distribution table, seen below.
The X Values and Y Values can be any number or character.
The Distribution Numbers are any number greater than or equal to 0.
The X Fixed and Y Fixed numbers are any integer greater than or equal to 0.
The following table is an example:
The Fixed numbers correspond to an X column or Y row in the table.
If using 0 as the Fixed integer, the Disimulate2D() function with randomly select an X column and/or Y row automatically.
Next is an example of using the Disimulate2D() function with the table above; when using different Fixed integers.
You'll notice the random selections are in a paired number format: X, Y.
Here is another example using just integers:
The Disimulate2D() function is used to produce the following table of a 100 samples.
In the Excel spreadsheet, you're not restricted to just numbers.
The Following is a table using characters as the Y Values.
The Disimulate2D() function works with those characters like numbers.
This is a 100 sample of the previous table.
Here's an interesting table of cards.
Yep, the Disimulate2D() function has no problem with these.
Well, here it is.
The Code.
Those of you that know how to add this to Excel should have no problem.
____________________________________________________________________________________________________
Function Disimulate2D(ByVal theXNumbers As Range, ByVal theYNumbers As Range, ByVal theDistribution As Range, ByVal x As Integer, ByVal y As Long) As Variant
On Error GoTo exitfunction
Dim a, b As Long
Dim d() As Double
Dim r, s0, s1 As Double
Dim NegativeNumbers As Boolean
If (x < 0) _
Or (x > theXNumbers.Columns.Count) _
Or (theXNumbers.Rows.Count > 1) _
Or (y < 0) _
Or (y > theYNumbers.Rows.Count) _
Or (theYNumbers.Columns.Count > 1) _
Or (theXNumbers.Columns.Count <> theDistribution.Columns.Count) _
Or (theYNumbers.Rows.Count <> theDistribution.Rows.Count) _
Then GoTo exitfunction
ReDim d(theDistribution.Rows.Count, theDistribution.Columns.Count)
d(0, 0) = 0
For a = 1 To theDistribution.Rows.Count
d(a, 0) = 0
Next
For b = 1 To theDistribution.Columns.Count
d(0, b) = 0
Next
NegativeNumbers = False
For a = 1 To theDistribution.Rows.Count
For b = 1 To theDistribution.Columns.Count
d(a, b) = theDistribution.Cells(a, b)
d(0, 0) = d(0, 0) + d(a, b)
d(a, 0) = d(a, 0) + d(a, b)
d(0, b) = d(0, b) + d(a, b)
If d(a, b) < 0 Then NegativeNumbers = True
Next
Next
If NegativeNumbers Then GoTo exitfunction
If (d(0, 0) = 0) Then GoTo exitfunction
If (x > 0) And (d(0, x) = 0) Then GoTo exitfunction
If (y > 0) And (d(y, 0) = 0) Then GoTo exitfunction
If (x = 0) And (y = 0) Then
If (Rnd() >= 0.5) Then
r = Rnd()
a = 0
s0 = 0: s1 = 0
Do
a = a + 1
s0 = s1
s1 = s0 + d(a, 0)
Loop Until (r >= (s0 / d(0, 0))) And (r < (s1 / d(0, 0)))
r = Rnd()
b = 0
s0 = 0: s1 = 0
Do
b = b + 1
s0 = s1
s1 = s1 + d(a, b)
Loop Until (r >= (s0 / d(a, 0))) And (r < (s1 / d(a, 0)))
Else
r = Rnd()
b = 0
s0 = 0: s1 = 0
Do
b = b + 1
s0 = s1
s1 = s1 + d(0, b)
Loop Until (r >= (s0 / d(0, 0))) And (r < (s1 / d(0, 0)))
r = Rnd()
a = 0
s0 = 0: s1 = 0
Do
a = a + 1
s0 = s1
s1 = s1 + d(a, b)
Loop Until (r >= (s0 / d(0, b))) And (r < (s1 / d(0, b)))
End If
Disimulate2D = theXNumbers.Cells(1, b) & ", " & theYNumbers.Cells(a, 1)
ElseIf (x > 0) And (y = 0) Then
r = Rnd()
a = 0
b = x
s0 = 0: s1 = 0
Do
a = a + 1
s0 = s1
s1 = s1 + d(a, b)
Loop Until (r >= (s0 / d(0, b))) And (r < (s1 / d(0, b)))
Disimulate2D = theXNumbers.Cells(1, b) & ", " & theYNumbers.Cells(a, 1)
ElseIf (x = 0) And (y > 0) Then
r = Rnd()
a = y
b = 0
s0 = 0: s1 = 0
Do
b = b + 1
s0 = s1
s1 = s1 + d(a, b)
Loop Until (r >= (s0 / d(a, 0))) And (r < (s1 / d(a, 0)))
Disimulate2D = theXNumbers.Cells(1, b) & ", " & theYNumbers.Cells(a, 1)
Else
a = y
b = x
Disimulate2D = theXNumbers.Cells(1, b) & ", " & theYNumbers.Cells(a, 1)
End If
Exit Function
exitfunction:
Disimulate2D = "Error"
End Function
____________________________________________________________________________________________________