Excel VBA 使用哪个随机数生成器？

Question

Question in the title - I was looking to establish which random number generator VBA uses ie, in Randomize and Rnd? According to Microsoft's documentation Excel itself uses Mersenne Twister - which is apparently very good, but you can't seed. I can't seem to find an answer for VBA in the Microsoft documentation.

I'm using Excel 365 for this as I appreciate this is something which could change from version to version.

Answer 1

The only piece of information I could obtain about the current (ie, Excel 365) random number generator used by Excel VBA is Visual Basic for Applications/A PRNG for VBA (a wikibook) , which states "Microsoft's Visual Basic for Applications (VBA), at present uses a linear congruential generator (LCG) for pseudo-random number generation in the Rnd() function" and at the bottom "This page was last edited on 16 April 2020, at 06:55." This alone would answer you question.

But since it is not necessarily an authoritative source, you would have to check this. Is Excel VBA's Rnd() really this bad? shows an example for how to do this.

As an alternative, this shows the basic algorithm for Excel's Rnd :

x1 = ( x0 * a + c ) MOD m
Rnd() = x1/m

where:

Rnd() = returned value
m = modulus = (2^24)
x1 = new value
x0 = previous value (initial value 327680)
a = 1140671485
c = 12820163
Repeat length = m = (2^24) = 16,777,216

You may implement it and compare the results it produces with the results from Rnd , and check if it is faithful.

Note: You are right in that this changed across versions. See, eg, How good is the RAND() function in Excel for Monte Carlo simulation? In particular, the update between 2007 ( On the accuracy of statistical procedures in Microsoft Excel 2007 ) and 2010 ( On the accuracy of statistical procedures in Microsoft Excel 2010 ). Perhaps there's a niche for yet another paper, as of now.

---

As for alternative generators, in case you don't like what is built-in, there are quite a few out there. A brief list (some are posted in comments) is given here, code is posted below for clarity:

1. Mersenne Twister in BASIC

2. VBA Code - Wichmann-Hill (1982)

3. Is Excel VBA's Rnd() really this bad? (answers there)

4. Mersenne Twister Random Number Generator Algorithm

---

Code from links above

1. Carmine Arturo Sangiovanni's implementation of Mersenne-Twister

' Visual Basic Mersenne-Twister ' Author: Carmine Arturo Sangiovanni ' carmine @ daygo.com.br ' daygo_gaming @ hotmail.com ' ' Aug 13,2004 ' ' based on C++ code ' ' ' Jan 4, 2010 ' rev1 ' bug fixes sent by Takano Akio (aljee @ hiper.cx) ' look for 'rev1:' to see changes Option Explicit Const N = 624 Const M = 397 Global mt(0 To N) As Currency Global mti As Currency Dim MATRIX_A As Currency Dim UPPER_MASK As Currency Dim LOWER_MASK As Currency Dim FULL_MASK As Currency Dim TEMPERING_MASK_B As Currency Dim TEMPERING_MASK_C As Currency Function tempering_shift_u(ty As Currency) tempering_shift_u = f_and(Int(ty / 2048@), FULL_MASK) End Function Function tempering_shift_s(ty As Currency) tempering_shift_s = and_ffffffff(ty * 128@) End Function Function tempering_shift_t(ty As Currency) tempering_shift_t = and_ffffffff(ty * 32768@) End Function Function tempering_shift_l(ty As Currency) tempering_shift_l = f_and(Int(ty / 262144@), FULL_MASK) End Function Function f_and(p1 As Currency, p2 As Currency) Dim v As Currency Dim i As Integer If (p1 < UPPER_MASK) And (p2 < UPPER_MASK) Then f_and = p1 And p2 End If If (p1 < UPPER_MASK) And (p2 >= UPPER_MASK) Then f_and = p1 And (p2 - UPPER_MASK) End If If (p1 >= UPPER_MASK) And (p2 < UPPER_MASK) Then f_and = (p1 - UPPER_MASK) And p2 End If If (p1 >= UPPER_MASK) And (p2 >= UPPER_MASK) Then f_and = (p1 - UPPER_MASK) And (p2 - UPPER_MASK) f_and = f_and + UPPER_MASK End If End Function Function f_or(p1 As Currency, p2 As Currency) Dim v As Currency Dim i As Integer Dim f As Boolean If (p1 < UPPER_MASK) And (p2 < UPPER_MASK) Then f_or = p1 Or p2 End If If (p1 < UPPER_MASK) And (p2 >= UPPER_MASK) Then f_or = p1 Or (p2 - UPPER_MASK) f_or = f_or + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 < UPPER_MASK) Then f_or = (p1 - UPPER_MASK) Or p2 'rev1: replaced 'And' with 'Or' f_or = f_or + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 >= UPPER_MASK) Then f_or = (p1 - UPPER_MASK) Or (p2 - UPPER_MASK) 'rev1: replaced 'And' with 'Or' f_or = f_or + UPPER_MASK End If End Function Function f_xor(p1 As Currency, p2 As Currency) Dim v As Currency Dim i As Integer Dim f1 As Boolean, f2 As Boolean If (p1 < UPPER_MASK) And (p2 < UPPER_MASK) Then f_xor = p1 Xor p2 End If If (p1 < UPPER_MASK) And (p2 >= UPPER_MASK) Then f_xor = p1 Xor (p2 - UPPER_MASK) f_xor = f_xor + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 < UPPER_MASK) Then f_xor = (p1 - UPPER_MASK) Xor p2 f_xor = f_xor + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 >= UPPER_MASK) Then f_xor = (p1 - UPPER_MASK) Xor (p2 - UPPER_MASK) End If End Function Function f_lower(ByVal p1 As Currency) 'rev1: added ByBal Do If p1 < UPPER_MASK Then f_lower = p1 Exit Do Else p1 = p1 - UPPER_MASK End If Loop End Function Function f_upper(ByVal p1 As Currency) 'rev1: added ByVal If p1 > LOWER_MASK Then f_upper = UPPER_MASK Else f_upper = 0 End If End Function Function f_xor3(p1 As Currency, p2 As Currency, p3 As Currency) Dim v As Currency Dim tmp As Currency Dim i As Integer Dim f As Integer If (p1 < UPPER_MASK) And (p2 < UPPER_MASK) Then tmp = p1 Xor p2 End If If (p1 < UPPER_MASK) And (p2 >= UPPER_MASK) Then tmp = p1 Xor (p2 - UPPER_MASK) tmp = tmp + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 < UPPER_MASK) Then tmp = (p1 - UPPER_MASK) Xor p2 tmp = tmp + UPPER_MASK End If If (p1 >= UPPER_MASK) And (p2 >= UPPER_MASK) Then tmp = (p1 - UPPER_MASK) Xor (p2 - UPPER_MASK) End If If (tmp < UPPER_MASK) And (p3 < UPPER_MASK) Then f_xor3 = tmp Xor p3 End If If (tmp < UPPER_MASK) And (p3 >= UPPER_MASK) Then f_xor3 = tmp Xor (p3 - UPPER_MASK) f_xor3 = f_xor3 + UPPER_MASK End If If (tmp >= UPPER_MASK) And (p3 < UPPER_MASK) Then f_xor3 = (tmp - UPPER_MASK) Xor p3 f_xor3 = f_xor3 + UPPER_MASK End If If (tmp >= UPPER_MASK) And (p3 >= UPPER_MASK) Then f_xor3 = (tmp - UPPER_MASK) Xor (p3 - UPPER_MASK) End If End Function Function and_ffffffff(ByVal c As Currency) 'rev1: added ByVal Dim e As Currency Dim i As Integer i = 32 Do e = 2 ^ (i + 16) Do While c >= e c = c - e Loop i = i - 1 Loop While i > 15 and_ffffffff = c End Function Sub random_init(seed As Currency) mt(0) = and_ffffffff(seed) For mti = 1 To N - 1 mt(mti) = and_ffffffff(69069 * mt(mti - 1)) Next mti End Sub Function Mersenne_twister_random(max As Integer) Dim kk As Integer Dim ty1 As Currency Dim ty2 As Currency Dim y As Currency Dim mag01(0 To 1) As Currency MATRIX_A = 2567483615@ '&H9908b0df UPPER_MASK = 2147483648@ '&H80000000 LOWER_MASK = 2147483647@ '&H7fffffff FULL_MASK = LOWER_MASK + UPPER_MASK '&Hffffffff TEMPERING_MASK_B = 2636928640@ '&H9d2c5680 TEMPERING_MASK_C = 4022730752@ '&Hefc60000 mag01(0) = 0@ mag01(1) = MATRIX_A If mti >= N Then If mti = N + 1 Then random_init 4537 End If For kk = 0 To (N - M) - 1 y = f_or(f_upper(mt(kk)), f_lower(mt(kk + 1))) mt(kk) = f_xor3(mt(kk + M), Int(y / 2@), mag01(f_and(y, 1))) Next kk For kk = kk To (N - 1) - 1 y = f_or(f_upper(mt(kk)), f_lower(mt(kk + 1))) mt(kk) = f_xor3(mt(kk + (M - N)), Int(y / 2@), mag01(f_and(y, 1))) Next kk y = f_or(f_upper(mt(N - 1)), f_lower(mt(0))) mt(N - 1) = f_xor3(mt(M - 1), Int(y / 2@), mag01(f_and(y, 1))) mti = 0 End If '--------------------------------------------------- y = mt(mti): mti = mti + 1 '--------------------------------------------------- y = f_xor(y, tempering_shift_u(y)) ty1 = f_and(tempering_shift_s(y), TEMPERING_MASK_B) y = f_xor(y, ty1) ty1 = f_and(tempering_shift_t(y), TEMPERING_MASK_C) y = f_xor(y, ty1) y = f_xor(y, tempering_shift_l(y)) '--------------------------------------------------- If max = 0 Then Mersenne_twister_random = 0 Else Mersenne_twister_random = Int(y / 32) Mod max End If End Function

2. Code here should be saved as a separate standard module in Excel.

 Option Explicit Dim nSamples As Long Dim nX As Long, nY As Long, nZ As Long Sub TestRndX() 'run this to obtain RndX() samples 'Wichmann, Brian; Hill, David (1982), Algorithm AS183: 'An Efficient and Portable Pseudo-Random Number Generator, 'Journal of the Royal Statistical Society. Series C Dim n As Long 'reset module variables nX = 0: nY = 0: nZ = 0 RandomizeX For n = 1 To 10 Debug.Print RndX() MsgBox RndX() Next n 'reset module variables nX = 0: nY = 0: nZ = 0 End Sub Sub TestScatterChartOfPRNG() 'run this to make a point scatter chart 'using samples from RndX Dim vA As Variant, n As Long Dim nS As Long, nR As Double 'remove any other charts 'DeleteAllCharts 'reset module variables nX = 0: nY = 0: nZ = 0 'set number of samples here nSamples = 1000 ReDim vA(1 To 2, 1 To nSamples) 'dimension array 'load array with PRNG samples RandomizeX For n = 1 To nSamples nR = RndX() vA(1, n) = n 'x axis data - sample numbers vA(2, n) = nR 'y axis data - prng values Next n 'make scatter point chart from array ChartScatterPoints vA, 1, 2, nSamples & " Samples of RndX()", _ "Sample Numbers", "PRNG Values [0,1]" 'reset module work variables nX = 0: nY = 0: nZ = 0 End Sub Sub RandomizeX(Optional ByVal nSeed As Variant) 'sets variables for PRNG procedure RndX() Const MaxLong As Double = 2 ^ 31 - 1 Dim nS As Long Dim nN As Double 'make multiplier If IsMissing(nSeed) Then nS = Timer * 60 Else nN = Abs(Int(Val(nSeed))) If nN > MaxLong Then 'no overflow nN = nN - Int(nN / MaxLong) * MaxLong End If nS = nN End If 'update variables nX = (nS Mod 30269) nY = (nS Mod 30307) nZ = (nS Mod 30323) 'avoid zero state If nX = 0 Then nX = 171 If nY = 0 Then nY = 172 If nZ = 0 Then nZ = 170 End Sub Function RndX(Optional ByVal nSeed As Long = 1) As Double 'PRNG - gets pseudo random number - use with RandomizeX 'Wichmann-Hill algorithm of 1982 Dim nResult As Double 'initialize variables If nX = 0 Then nX = 171 nY = 172 nZ = 170 End If 'first update variables If nSeed <> 0 Then If nSeed < 0 Then RandomizeX (nSeed) nX = (171 * nX) Mod 30269 nY = (172 * nY) Mod 30307 nZ = (170 * nZ) Mod 30323 End If 'use variables to calculate output nResult = nX / 30269# + nY / 30307# + nZ / 30323# RndX = nResult - Int(nResult) End Function Sub ChartScatterPoints(ByVal vA As Variant, RowX As Long, RowY As Long, _ Optional sTitle As String = "", Optional sXAxis As String, _ Optional sYAxis As String) 'array input must contain two data rows for x and y data 'parameters for user title, x axis and y axis labels 'makes a simple point scatter chart Dim LBC As Long, UBC As Long, LBR As Long, UBR As Long, n As Long, bOptLim As Boolean Dim X As Variant, Y As Variant, sX As String, sY As String, sT As String, oC As Chart LBR = LBound(vA, 1): UBR = UBound(vA, 1) LBC = LBound(vA, 2): UBC = UBound(vA, 2) ReDim X(LBC To UBC) ReDim Y(LBC To UBC) 'labels for specific charts If sTitle = "" Then sT = "Title Goes Here" Else sT = sTitle If sXAxis = "" Then sX = "X Axis Label Goes Here" Else sX = sXAxis If sYAxis = "" Then sY = "Y Axis Label Goes Here" Else sY = sYAxis If RowX < LBR Or RowX > UBR Or RowY < LBC Or RowY > UBC Then MsgBox "Parameter data rows out of range in ChartColumns - closing" Exit Sub End If 'transfer data to chart arrays For n = LBC To UBC X(n) = vA(RowX, n) 'x axis data Y(n) = vA(RowY, n) 'y axis data Next n 'make chart Charts.Add 'set chart type ActiveChart.ChartType = xlXYScatter 'point scatter chart 'remove unwanted series With ActiveChart Do Until.SeriesCollection.Count = 0.SeriesCollection(1).Delete Loop End With 'assign the data and labels to a series With ActiveChart.SeriesCollection If.Count = 0 Then.NewSeries If Val(Application.Version) >= 12 Then.Item(1).Values = Y.Item(1).XValues = X Else.Item(1).Select Names.Add "_", X ExecuteExcel4Macro "series.x(._)" Names,Add "_". Y ExecuteExcel4Macro "series,y(.,_)" Names("_"),Delete End If End With 'apply title string. x and y axis strings. and delete legend With ActiveChart.HasTitle = True.ChartTitle.Text = sT.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis) 'X.Axes(xlCategory).AxisTitle.Text = sX.SetElement (msoElementPrimaryValueAxisTitleRotated) 'Y.Axes(xlValue).AxisTitle.Text = sY.Legend.Delete End With 'trim axes to suit With ActiveChart 'X Axis.Axes(xlCategory).Select.Axes(xlCategory).MinimumScale = 0.Axes(xlCategory).MaximumScale = nSamples.Axes(xlCategory).MajorUnit = 500.Axes(xlCategory).MinorUnit = 100 Selection.TickLabelPosition = xlLow 'Y Axis.Axes(xlValue).Select.Axes(xlValue).MinimumScale = -0.2.Axes(xlValue).MaximumScale = 1.2.Axes(xlValue).MajorUnit = 0.1.Axes(xlValue).MinorUnit = 0.05 End With ActiveChart.ChartArea.Select Set oC = Nothing End Sub Sub DeleteAllCharts5() 'run this to delete all ThisWorkbook charts Dim oC Application.DisplayAlerts = False For Each oC In ThisWorkbook.Charts oC.Delete Next oC Application.DisplayAlerts = True End Sub

3. This is a SO link.

4. This is a workbook for downloading.

Answer 2

You can access Excel's RAND function from VBA - annoyingly, it isn't included in Application.WorksheetFunction, but there is a much faster way anyway, if you have Excel 365.

The code below uses the new RANDARRAY function to pull in 1000 random numbers from Excel, use them as needed, and pull in more as required. Retrieving many at a time greatly improves speed.

Function RandXLa() 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
  RandXLa = R(Remaining, 1)
  Remaining = Remaining - 1
End Function

Answer 3

Should you require truly random numbers , study my project VBA.Random .

Among other functions, matching different purposes, it also contains a direct substitute for 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