' VBA での SRnd(), Back(), Jump() MyRnd(), MyRandomize(), MySRnd() のプログラム。
' 64bit excelでは LongLong を使い、32 bit エクセルでは Double を使う。
' 64bit で Double にするには 8行目の "Win64" を "False" に変える。
' ※ MyRandomize を実行すると同じ引数で Randomize も実行される。
'    同様に MySRnd を実行すると同じ引数で SRnd も実行される。
Option Explicit

#Const MyRndLongLong = Win64

Const TP24 = 16777216#

#If MyRndLongLong Then
Private MySeed As LongLong
#Else
Private MySeed As Double
#End If
Private MySeedInitialized As Boolean

Private Type Long1: x As Long: End Type
Private Type Sing1: x As Single: End Type
Private Type Doub1: x As Double: End Type
Private Type Inte2: x(0 To 1) As Integer: End Type
Private Type Inte4: x(0 To 3) As Integer: End Type
Private Type Byte8: x(0 To 7) As Byte: End Type

Public Sub SRnd(Optional ByVal seed As Long = 327680)
    seed = seed And 16777215
    Rnd CSng(-(((seed * 85 + 130) And 255) / 8388608! + 1!))
    Randomize CDbl((seed Xor 4190208) / 268435456# + 1#)
End Sub

Public Function Back() As Single
    Dim x As Double, r As Single: r = Rnd(0)
    x = (r * 16777216# + 3957053#) * 602453#
    x = x - Fix(x / 16777216#) * 16777216#
    SRnd (CLng(x)): Back = r
End Function

Public Function Jump(ByVal lag As Long) As Single
    Dim a, c, x As Double
    If lag = 0 Then Exit Function
    x = Rnd(0) * 16777216#: a = 16598013#: c = 12820163#
    If lag < 0 Then a = 602453#: c = 13497921#: lag = -lag
    lag = lag And 16777215
    Do
        If (lag And 1) = 1 Then x = a * x + c: x = x - Fix(x / 16777216#) * 16777216#
        lag = lag \ 2
        If lag = 0 Then SRnd CLng(x): Exit Function
        c = (a + 1) * c: c = c - Fix(c / 16777216#) * 16777216#
        a = a * a:       a = a - Fix(a / 16777216#) * 16777216#
    Loop
End Function

Public Sub MySRnd(Optional ByVal seed As Long = 327680)
    SRnd seed: MySeedInitialized = True: MySeed = seed And 16777215
End Sub

Public Function MyRnd(Optional ByVal a As Single = 1) As Single
    Dim s As Sing1, g As Long1
    If Not MySeedInitialized Then MySeed = 327680: MySeedInitialized = True
    If a <> 0# Then
#If MyRndLongLong Then
        If a < 0# Then
            s.x = a: LSet g = s: MySeed = g.x + 4294967296^
            MySeed = (MySeed \ 16777216) + MySeed
            MySeed = MySeed And 16777215
        End If
        MySeed = MySeed * 16598013 + 12820163
        MySeed = MySeed And 16777215
#Else
        If a < 0# Then
            s.x = a: LSet g = s: MySeed = g.x + 4294967296#
            MySeed = Fix(MySeed / TP24) + MySeed
            MySeed = MySeed - Fix(MySeed / TP24) * TP24
        End If
        MySeed = MySeed * 16598013# + 12820163#
        MySeed = MySeed - Fix(MySeed / TP24) * TP24
#End If
    End If
    MyRnd = CSng(MySeed / TP24)
End Function

Public Sub MyRandomize(Optional ByVal a)
    Dim s As Sing1, w2 As Inte2, d As Doub1, w4 As Inte4, y As Long, c, p As Single
    If Not MySeedInitialized Then MySeed = 327680: MySeedInitialized = True
    If IsMissing(a) Then
        c = Timer(): Do: p = c: c = Timer(): Loop While p = c
        s.x = c: Randomize: LSet w2 = s: y = w2.x(0) Xor w2.x(1)
    Else
        Randomize a: d.x = CDbl(a): LSet w4 = d: y = w4.x(2) Xor w4.x(3)
    End If
    If y < 0 Then y = y + 65536
#If MyRndLongLong Then
    MySeed = (CLngLng(y) * 256) Or (MySeed And 255)
#Else
    MySeed = (y * 256#) + (Fix(MySeed) Mod 256)
#End If
End Sub