Excel UDF 加权 RANDBETWEEN（）-解网

问：

好吧，不是真的.我正在尝试创建一个 UDF 来返回数组中数字的索引，其中数字越大，被选中的可能性就越大。RANDBETWEEN()

我知道如何在工作表中为随机数分配概率（即使用概率之和，SO 上有很多东西可以解释这一点），但我想要一个 UDF，因为我将一个特殊的输入数组传递到函数中 - 而不仅仅是一个选定的范围。MATCH()

我的问题是，权重已关闭，数组中后面的数字比数组中前面的数字更有可能返回，而且我看不到代码中哪里出错了。以下是到目前为止的 UDF：

Public Function PROBABLE(ParamArray inputArray() As Variant) As Long
'Takes a set of relative or absolute probabilities and ranks a random number within them
Application.Volatile (True)
Dim outputArray() As Variant
Dim scalar As Single
Dim rankNum As Single
Dim runningTot As Single

'''''
'Here I take inputArray() and convert to outputArray(), 
'which is fed into the probability code below
'''''

scalar = 1 / WorksheetFunction.Sum(outputArray)
rankNum = Rnd()
runningTot = 0

For i = 0 To UBound(outputArray)
    runningTot = runningTot + outputArray(i)
    If runningTot * scalar >= rankNum Then
        PROBABLE = i + 1
        Exit Function
    End If
Next i

End Function

该函数应查看数字的相对大小，并随机选择，但对较大的数字进行加权。例如的应该分别分配概率但是，当我测试，对于 1000 个样本和 100 次迭代，并绘制数组中项目 1 或项目 4 返回的频率时，我得到了这个结果：outputArray()outputArray(){1,0,0,1}{50%,0%,0%,50%}outputArray()

约20%：80%分布。绘图（所有人都应该有平等的机会）给出了 10%：20%：30%：40% 的分布{1,1,1,1}

我知道我错过了一些明显的东西，但我说不出是什么，有什么帮助吗？

更新

有些人要求提供完整的代码，就在这里。

Public Function PROBABLE(ParamArray inputArray() As Variant) As Long
'Takes a set of relative or absolute probabilities and ranks a random number within them
Application.Volatile (True) 'added some dimensions up here
Dim outputArray() As Variant
Dim inElement As Variant
Dim subcell As Variant
Dim scalar As Single
Dim rankNum As Single
Dim runningTot As Single
'convert ranges to values
'creating a new array from the mixture of ranges and values in the input array
''''
'This is where I create outputArray() from inputArray()
''''
ReDim outputArray(0)
For Each inElement In inputArray
'Normal values get copied from the input UDF to an output array, ranges get split up then appended
    If TypeName(inElement) = "Range" Or TypeName(inElement) = "Variant()" Then
        For Each subcell In inElement
            outputArray(UBound(outputArray)) = subcell
            ReDim Preserve outputArray(UBound(outputArray) + 1)
        Next subcell
    'Stick the element on the end of an output array
    Else
        outputArray(UBound(outputArray)) = inElement
        ReDim Preserve outputArray(UBound(outputArray) + 1)
    End If
Next inElement
ReDim Preserve outputArray(UBound(outputArray) - 1)
''''
'End of new code, the rest is as before
''''
scalar = 1 / WorksheetFunction.Sum(outputArray)
rankNum = Rnd()
runningTot = 0

For i = 0 To UBound(outputArray)
    runningTot = runningTot + outputArray(i)
    If runningTot * scalar >= rankNum Then
        PROBABLE = i + 1
        Exit Function
    End If
Next i

End Function

开始 🡒 部分用于标准化不同的输入法。即用户可以输入值、单元格引用/范围和数组的混合，并且函数可以应对。例如 （你明白了）应该和.我循环浏览 inputArray（）的子元素并将它们放在我的 outputArray（）中。我相当确定这部分代码没有问题。inputArray()outputArray(){=PROBABLE(A1,5,B1:C15,IF(ISTEXT(D1:D3),LEN(D1:D3),0))}=PROBABLE(A1:A3)

然后为了得到我的结果，我将 UDF 复制到，使用 a 或代替 count 1，我确实对每个可能的 UDF 输出计数 2、3、4 等，并制作了一个简短的宏来重新计算工作表 100 次，每次将 countif 的结果复制到表格中以绘制图表。我不能确切地说我是怎么做到的，因为我把这一切都留在了工作上，但我会在周一更新。A1:A1000COUNTIF(A1:A1000,1)

VBA Excel 用户定义函数

Option Explicit
Public Function TryMyRandom() As String

    Dim lngTotalChances         As Long
    Dim i                       As Long
    Dim previousValue           As Long
    Dim rnd                     As Long
    Dim result                  As Variant

    Dim varLngInputArray        As Variant
    Dim varLngInputChances      As Variant
    Dim varLngChancesReedit     As Variant

    varLngInputChances = Array(1, 2, 3, 4, 5)
    varLngInputArray = Array("a", "b", "c", "d", "e")
    lngTotalChances = Application.WorksheetFunction.Sum(varLngInputChances)
    rnd = Application.WorksheetFunction.RandBetween(1, lngTotalChances)

    ReDim varLngChancesReedit(UBound(varLngInputChances))

    For i = LBound(varLngInputChances) To UBound(varLngInputChances)
        varLngChancesReedit(i) = varLngInputChances(i) + previousValue
        previousValue = varLngChancesReedit(i)

        If rnd <= varLngChancesReedit(i) Then
            result = varLngInputArray(i)
            Exit For
        End If
    Next i

    TryMyRandom = result

End Function

Public Sub TestMe()

    Dim lng     As Long
    Dim i       As Long
    Dim dict    As Object
    Dim key     As Variant
    Dim res     As String

    Set dict = CreateObject("Scripting.Dictionary")

    For lng = 1 To 1000

        res = TryMyRandom
        If dict.Exists(res) Then
            dict(res) = dict(res) + 1
        Else
            dict(res) = 1
        End If


    Next lng

    For Each key In dict.Keys
        Debug.Print key & " ===> " & dict(key)
    Next


End Sub

关于您的情况，请确保对数组进行排序。例如，在我的情况下，谈论 .我没有看过极端情况，那里可能存在错误。varLngInputChances

运行潜艇。它甚至会生成结果的摘要。如果将变体更改为，则会给出：TestMevarLngInputChances = Array(1, 1, 0, 0, 1)

a ===> 329 b ===> 351 e ===> 320

这是相当不错的随机:)您可以在此处更改样本的数量：，它的工作速度非常快。我刚刚尝试了 100,000 次测试。For lng = 1 To 1000

4赞 CallumDA 2/10/2017 #2

试试这个：

Function Probable(v As Variant) As Long
    Application.Volatile 'remove this if you don't want a volatile function

    Dim v2 As Variant
    ReDim v2(LBound(v) To UBound(v) + 1)

    v2(LBound(v2)) = 0
    Dim i As Integer
    For i = LBound(v) To UBound(v)
        v2(i + 1) = v2(i) + v(i) / Application.Sum(v)
    Next i

    Probable = Application.WorksheetFunction.Match(Rnd(), v2, 1)
End Function

该数组本质上是您的 .voutputArray

该代码采用一个数组 like 并将其转换为（注意开头的），此时您可以按照建议执行 a，以相等的概率获得任何一个。{1,0,0,1}{0,0.5,0.5,1}0MATCH1 or 4

同样，如果您要开始，它将以相等的概率转换为并返回任何一个。{1,1,1,1}{0,0.25,0.5,0.75,1}1, 2, 3 or 4

另请注意：如果您将的值保存在变量中，而不是对数组中的每个值执行计算，您可能会使它更快一些。Application.Sum(v)v

更新
该函数现在作为参数 -- 就像你的代码一样。我还对它进行了一些调整，以便它可以处理任何基础，这意味着您也可以从工作表中运行它：例如vv=Probable({1,0,0,1})

2赞 Greedo 2/11/2017 #3

看来我犯了一个悲惨的错误。我的代码很好，我的计数不是那么好。我在图形中使用而不是，导致数组中的后续对象（具有更高的索引 - 我应该计数的 UDF 的输出，但求和）获得与其位置成正比的权重。SUMIF()COUNTIF()

回想起来，我认为有人比我聪明得多，可能会从提供的信息中推断出这一点。我说有一个，这是一个{1：2：3：4}的比率，它与输出的指数完全相同，扣除：输出相加不计算。{1,1,1,1}{10%:20%:30%:40%}

同样，带有输出的图表，将每个百分比除以其指数（20%/1、80%/4）和 Hey Presto，或我预期的 1：1 比率。{1,0,0,1}{20%:0%:0%:80%}{20%:0%:0%:20%}

有些烦人但令人满意——知道答案一直在那里。我想这一切可能都有寓意。至少这篇文章可以警告初出茅庐的 VBA 用户检查他们的算术。

上一个：为什么我不能在不破坏所有内容的情况下在子类化时“结束”代码？

下一个：在 Windows 上与 conda 一起或与 conda 一起安装 Python alpha 和 beta 版本有哪些选项？

Excel UDF 加权 RANDBETWEEN（）

Excel UDF weighted RANDBETWEEN()

更新

评论