I am a supporter ofSt. Joseph's hospice. If you find this site useful or if it helped you, consider a small donation toSt. Joseph's, please. Information onSt. Joseph's  Special cases may require special non-equidistant but stepwise constant distributions. These could be created with this function rww(). Function rww(ParamArray w() As Variant) As Double'Produces random numbers with defined widths & weights'06/08/2004 by Bernd Plumhoff. rww expects a vector of n random widths and'weightings of type double and returns a random number of type double. 'This random number will lie in the given n-width-range of the'(0,1)-intervall with the given likelihood of the n weightings.'Examples:'a) rww(1,0,1,1,8,0) will return a random number between 0.1 and 0.2'b) rww(5,2,5,1) will return a random number between 0 and 0.5 twice as'   often as a random number between 0.5 and 1.'c) rww(1/3,0,1/3,1,1/3,0) will return a random number between'   0.33333333333333 and 0.66666666666666.'d) rww(5,15.4,3,7.7,2,0) would return a random value between'   0 and 0.8, first 5 deciles with double likelihood than decile 6-8.Dim i As IntegerDim swidths As DoubleDim sw As DoubleIf (UBound(w) + 1) Mod 2 <> 0 Then    rww = -2     'No even number of arguments: Error    Exit FunctionEnd IfReDim swidthsi(0 To (UBound(w) + 1) / 2 + 1) As DoubleReDim swi(0 To (UBound(w) + 1) / 2 + 1) As DoubleReDim weights(0 To (UBound(w) + 1) / 2) As DoubleReDim widths(0 To (UBound(w) + 1) / 2) As Double    swidths = 0#    sw = 0#    swi(0) = 0#    swidthsi(0) = 0#    For i = 0 To (UBound(w) - 1) / 2        If w(2 * i) < 0# Then     'A negative width is an error            rww = -3#            Exit Function        End If        widths(i) = w(2 * i)        swidths = swidths + widths(i)        swidthsi(i + 1) = swidths        If w(2 * i + 1) < 0# Then 'A negative weight is an error            rww = -1#            Exit Function        End If        weights(i) = w(2 * i + 1)        If widths(i) > 0# Then            sw = sw + weights(i)        End If        swi(i + 1) = sw    Next i    rww = sw * Rnd    i = (UBound(w) - 1) / 2 + 1     'i already equals (UBound(w) - 1) /                                    '2 + 1, you may omit this statement.    While rww < swi(i)        i = i - 1    Wend        rww = (swidthsi(i) + (rww - swi(i)) / weights(i) * widths(i)) / swidthsEnd Function
 Sulprobil   Get it done   Contact   Disclaimer   Impressum   Download