'=====================================================================
' Efficient Forward and Backward Navigation of the Rnd() Sequence in VBA
' coded by isaku@pb4.so-net.ne.jp 2026
'=====================================================================
Option Explicit
' Initializes the Rnd() sequence with a specific seed.
' If no seed is provided, resets the sequence to its default state.
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
' Retrieves the previous value in the Rnd() sequence (i.e., steps backward).
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
' Performs an efficient relative jump within the Rnd() sequence.
' Positive values move forward; negative values move backward.
Public Sub Jump(ByVal lag As Long)
Dim a, c, x As Double
If lag = 0 Then Exit Sub
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 Sub
c = (a + 1) * c: c = c - Fix(c / 16777216#) * 16777216#
a = a * a: a = a - Fix(a / 16777216#) * 16777216#
Loop
End Sub
' Performs an efficient absolute jump to a specific position in the Rnd() sequence.
Public Sub AbsJump(ByVal lag As Long)
Call SRnd: Jump lag
End Sub
'======================================
' Test Routines for Rnd() Sequence Control
'======================================
Public Sub TestBack()
Dim i As Long
[A1] = "Reverse Rnd()": SRnd
For i = 3 To 8: Cells(1, i) = Rnd(): Next
For i = 8 To 3 Step -1: Cells(2, i) = Back(): Next
End Sub
Public Sub TestJumpForward()
Dim i As Long
Const n = 100
[A3] = "Jump Forward": SRnd
For i = 1 To n: Call Rnd: Next
For i = 3 To 8: Cells(3, i) = Rnd(): Next
AbsJump n
For i = 3 To 8: Cells(4, i) = Rnd(): Next
End Sub
Public Sub TestJumpBackward()
Dim i As Long
Const n = 100
[A5] = "Jump Backward": SRnd
For i = 1 To n: Call Back: Next
For i = 3 To 8: Cells(5, i) = Rnd(): Next
AbsJump -n
For i = 3 To 8: Cells(6, i) = Rnd(): Next
End Sub