在Excel VBA中查找Rnd的良好替代品



众所周知,Excel中的Rnd函数很弱,而Excel中的RAND函数基于Mersenne算法,而且更强。我一直在努力寻找一种快速而强大的Rnd替代方案,并考虑了各种选择,包括使用Mersenne,但这需要大量代码。

另一个选项是从VBA调用Excel RAND函数,但每次调用一个函数时速度非常慢。然而,Excel365中的新函数RANDARRAY允许VBA一次性从Excel中调用大量随机数,根据需要使用它们,并在必要时返回获取更多。这种方法快速(仅比Rnd慢4倍,比Mersenne代码快(且紧凑——代码如下。

我分享这些是希望找到解决这个问题的最佳集体方案。

Function RandXL() As Single
Static Remaining As Long, R() As Variant
If Remaining = 0 Then 'get more numbers if necessary
R = Application.WorksheetFunction.RandArray(1000, 1)
Remaining = 1000
End If
RandXL = R(Remaining, 1)
Remaining = Remaining - 1
End Function

您可以使用真正的随机数,如我的VBA工程中所示。随机的

它包含Rnd:的直接替代品

' Returns a true random number as a Double, like Rnd returns a Single.
' The value will be less than 1 but greater than or equal to zero.
'
' Usage: Excactly like Rnd:
'
'   TrueRandomValue = RndQrn[(Number)]
'
'   Number < 0  ->  The same number every time, using Number as the seed.
'   Number > 0  ->  The next number in the pseudo-random sequence.
'   Number = 0  ->  The most recently generated number.
'   No Number   ->  The next number in the pseudo-random sequence.
'
' 2019-12-21. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function RndQrn( _
Optional ByVal Number As Single = 1) _
As Double

Static Value            As Double

Select Case Number
Case Is > 0 Or (Number = 0 And Value = 0)
' Return the next number in the random sequence.
Value = CDbl(QrnDecimal)
Case Is = 0
' Return the most recently generated number.
Case Is < 0
' Not supported by QRN.
' Retrieve value from RndDbl.
Value = RndDbl(Number)
End Select

' Return a value like:
' 0.171394365283966
RndQrn = Value

End Function

此外,还提供了一个可供下载的演示(RandomQrn.xlsm(。

这设置了对Microsoft Access 16.0对象库的引用,该库使用了Nz函数。如果你不喜欢这个参考,这个替代品可以:

' Replacement for the function Application.Nz() of Access.
'
' 2015-12-10. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function Nz( _
ByRef Value As Variant, _
Optional ByRef ValueIfNull As Variant = "") _
As Variant
Dim ValueNz     As Variant

If Not IsEmpty(Value) Then
If IsNull(Value) Then
ValueNz = ValueIfNull
Else
ValueNz = Value
End If
End If

Nz = ValueNz

End Function