Function redw(ParamArray vWeights() As Variant) As Double 'Reverse("moc.LiborPlus.www") V0.50 09Dec2009 PB 'Produces random numbers with equidistant weights. Redw expects a vector of n random 'weights of type double and returns a random number of type double. This random 'number will lie in the given equidistant nsplitrange of the [0,1)intervall 'with the given likelihood of weightings. Examples: 'a) redw(0,1,0,0,0,0,0,0,0,0) will return a random number d, 0.1 <= d < 0.2 'b) redw(2,1) will return a random number between 0 and 0.5 twice as ' often as a random number between 0.5 and 1. 'c) redw(0,1,0) will return a random number d, 0.333333333333333 <= d < 0.666666666666666. 'd) redw(15.4,15.4,15.4,15.4,15.4,7.7,7.7,7.7,0,0) would return a random value between ' 0 and 0.8, first 5 deciles with double likelihood than decile 68.
Dim i As Integer Dim dw As Double ReDim dwi(0 To UBound(vWeights) + 2) As Double dw = 0# dwi(0) = 0# For i = 0 To UBound(vWeights) If vWeights(i) < 0# Then 'A negative weight is an error redw = CVErr(xlErrValue) Exit Function End If dw = dw + vWeights(i) 'Calculate sum of all weights dwi(i + 1) = dw 'Calculate sum of weights till i Next i
redw = dw * Rnd i = UBound(vWeights) + 1 'i already equals UBound(vWeights) + 1, you may omit this statement. Do While redw < dwi(i) i = i  1 Loop redw = (CDbl(i) + (redw  dwi(i)) / vWeights(i)) / (CDbl(UBound(vWeights) + 1))
End Function
