' VBA の Rnd() と MyRnd() との比較 Option Explicit #If Win64 Then Public Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal sz As Long) #Else Public Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal sz As Long) #End If Private x As Double ' MyRnd() の状態 Private initialized As Boolean ' 状態 "x" が初期化されれば True Public Sub ComparisonTest() Dim i As Long Cells(1, 1) = "Rnd()" Cells(1, 2) = "MyRnd()" Randomize MyRandomize For i = 2 To 25 Cells(i, 1) = Rnd() Cells(i, 2) = MyRnd() Next i End Sub Public Function MyRnd(Optional ByVal a! = 1) As Single Dim u As Long Dim d As Double If Not initialized Then x = 327680 initialized = True End If If a <> 0# Then If a < 0# Then Call RtlMoveMemory(u, a, 4) d = u + 4294967296# x = Int(d / 16777216#) + d x = x - Int(x / 16777216#) * 16777216# ' x = x Mod 16777216 End If x = x * 16598013# + 12820163# x = x - Int(x / 16777216#) * 16777216# ' x = x Mod 16777216 End If MyRnd = x / 16777216# End Function Public Sub MyRandomize(Optional ByVal a) Dim s As Single Dim c(7) As Byte Dim i As Long Dim d As Double If Not initialized Then x = 327680 initialized = True End If If IsMissing(a) Then s = Timer() Call RtlMoveMemory(c(0), s, 4) x = ((c(0) Xor c(2)) * 256&) Or ((c(1) Xor c(3)) * 65536) Or (Int(x) Mod 256) Else d = a Call RtlMoveMemory(c(0), d, 8) x = ((c(4) Xor c(6)) * 256&) Or ((c(5) Xor c(7)) * 65536) Or (Int(x) Mod 256) End If End Sub