Try this:
Sub Demo()
Dim i As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = 1 To 1000
Cells(Rows.Count, "B").End(xlUp)(2).Value = RandGugg(Array(0.05, 0.2, 0.65, 0.85), _
Array(50000, 100000, 200000, 300000, 450000))
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Function RandGugg(avdCum As Variant, avdVal As Variant) As Double
' VBA function ONLY
' avdCum contains the CUMULATIVE density function, e.g.,
' {0.05,0.2,0.65,0.85}
' => The first value is omitted and IMPLICITLY 0 (would appear in the formula version)
' => The last value is IMPLICITLY 1 (wouldn't appear in the formula version either)
' => Values MUST BE strictly monotone ascending
' avdVal contains the associated values to be interpolated,
' and must have ONE MORE value than avdCum
Dim dRnd As Double
Dim i As Long
Dim iLB As Long
iLB = LBound(avdCum)
If LBound(avdVal) <> iLB Then Exit Function
If UBound(avdVal) <= UBound(avdCum) Then Exit Function
dRnd = CDbl(Rnd)
If dRnd <= avdCum(iLB) Then
dRnd = Rnd
RandGugg = dRnd * avdVal(iLB)
Else
i = WorksheetFunction.Match(dRnd, avdCum)
dRnd = Rnd
RandGugg = dRnd * avdVal(i + iLB) + (1 - dRnd) * avdVal(i + iLB - 1)
End If
End Function
Bookmarks