首页 > 解决方案 > 我可以使用 API 或其他东西来接近 VBA 中的 TRUE RANDOM NUMBER 吗?

问题描述

我可以在 VBA 中访问 API、库或其他基于芯片组的命令吗?

我目前有一个获取随机数的设置;然而,当我对结果集进行测试时,这些数字甚至没有接近生成良好的统计曲线。我通过生成 600 个 2 个六面骰子的模拟卷来测试这一点,每次总计 2 个骰子。我希望 7 号能取得巨大的领先。然而,它两次排在第二位,离创建的适当统计曲线还差得很远。

我当前的代码使用标准的 VBA 方法,但正如我所说,统计测试失败:

Randomize
GetRandomNo = Int((6 * RND) + 1)

标签: vbaapims-accessencryptionchipset

解决方案


对于一个相当完整的答案:

生成随机数的方法有很多,但其中一种方法是使用 Windows API 来完成繁重的工作。Windows 具有生成加密安全随机字节的 API 函数,这些函数可以利用硬件随机数提供程序。

首先,我们声明 API 函数:

Public Declare PtrSafe Function BCryptOpenAlgorithmProvider Lib "bcrypt.dll" (ByRef phAlgorithm As LongPtr, ByVal pszAlgId As LongPtr, ByVal pszImplementation As LongPtr, ByVal dwFlags As Long) As Long
Public Declare PtrSafe Function BCryptGenRandom Lib "bcrypt.dll" (ByVal hAlgorithm As LongPtr, pbBuffer As Any, ByVal cbBuffer As Long, ByVal dwFlags As Long) As Long
Public Declare PtrSafe Function BCryptCloseAlgorithmProvider Lib "bcrypt.dll" (ByVal hAlgorithm As LongPtr, ByVal dwFlags As Long)

然后,我们使用这个调用,并使用模数将我们的数字减少到所需范围内的一:

Public Function RandomRangeWinApi(Lower As Long, Upper As Long) As Long
    Dim hAlg As LongPtr
    Dim iAlg As String
    iAlg = "RNG" & vbNullChar
    BCryptOpenAlgorithmProvider hAlg, StrPtr(iAlg), 0, 0
    Dim lRandom As Long
    BCryptGenRandom hAlg, lRandom, LenB(lRandom), 0
    RandomRangeWinApi = Abs(lRandom) Mod (Upper - Lower + 1) + Lower
    BCryptCloseAlgorithmProvider hAlg, 0
End Function

如果您假设整数具有无限范围的值,则此方法很好。但是,它没有,这意味着在极限情况下它是不精确的。同样,乘法假设一个无限精确的数字,这也是不正确的,并且会导致轻微的偏差。

我们可以通过直接使用数字的二进制表示来解决这个问题,并丢弃不属于此模板的数字:

Public Function RandomRangeExact(Lower As Long, Upper As Long) As Long
    'Initialize random number generator
    Dim hAlg As LongPtr
    Dim iAlg As String
    iAlg = "RNG" & vbNullChar
    BCryptOpenAlgorithmProvider hAlg, StrPtr(iAlg), 0, 0
    'Initialize bit template
    Dim template As Long
    Dim i As Long
    Do While template < Upper - Lower
        template = template + 2# ^ i
        i = i + 1
    Loop
    Dim lRandom As Long
    Do
        'Generate random number
        BCryptGenRandom hAlg, lRandom, LenB(lRandom), 0
        'Limit it to template
        lRandom = lRandom And template
    Loop While lRandom > (Upper - Lower) 'Regenerate if larger than desired range (should happen less than 50% of times)
    RandomRangeExact = lRandom + Lower
    BCryptCloseAlgorithmProvider hAlg, 0
End Function

现在,让我们研究一下您的解决方案的性能以及掷骰子的两种机会:我为 1 到 6 之间的每种方法模拟了 100000 个随机数。

这是结果:

在此处输入图像描述

虽然第一种方法似乎在数字之间有较大的差异(特别是更少的数字和更多的数字),但对于大多数应用程序,我认为第一种方法足够准确。


推荐阅读