Excel UDF加权RANDBETWEEN（）
那么不是真的RANDBETWEEN() 。 我试图创build一个UDF来返回一个数组中的数字的索引，其中数字越大，被选中的可能性就越大。
我知道如何将概率分配给工作表中的随机数（例如，在概率总和上使用MATCH() ，所以在这里解释了很多东西），但是我想要一个UDF，因为我将一个特殊的input数组该function – 不只是一个选定的范围。
我的问题是，权重是closures的，数组中的数字比数组中的更早被返回，我不能看到我的代码中哪里出了错。 到目前为止，这是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
函数应该查看outputArray()中的数字的相对大小，然后随机选取，但加权为较大的数字。 例如{1,0,0,1} outputArray()应该分别给出{50%,0%,0%,50%}概率。然而，当我testingoutputArray() ，对于1000个样本和100次迭代，在数组中，项目1或项目4的返回频率是多less，我得到了这个结果： 
大约20％：80％的分布。 绘制{1,1,1,1} （都应该有相同的机会）给出了10％：20％：30％：40％的分布
我知道我错过了一些明显的东西，但是我不能说什么，有什么帮助吗？
UPDATE
有些人要求完整的代码，在这里。
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 outputArray()部分用于标准化不同的input方法。 即用户可以input值，单元格引用/范围和数组的混合，并且该函数可以应付。 例如{=PROBABLE(A1,5,B1:C15,IF(ISTEXT(D1:D3),LEN(D1:D3),0))} （你得到的图片）应该和=PROBABLE(A1:A3) 。 我循环访问inputArray（）的子元素，并把它们放在我的outputArray（）中。 我相当肯定，这部分代码没有任何问题。
然后为了得到我的结果，我将UDF复制到A1:A1000 ，使用了COUNTIF(A1:A1000,1) ，而不是计数1，我为每个可能的UDF输出计数了2,3,4等等，短macros重新计算表单100次，每次将countif的结果复制到一个表中进行graphics化。 我不能确切地说我是怎么做到的，因为我把这一切都放在了工作上，但星期一我会更新。
尝试这个：
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
数组v基本上是你的outputArray 。
代码需要像{1,0,0,1}这样的数组并将其转换为{0,0.5,0.5,1} （注意开始时为0 ），在这一点上，您可以按照您的build议进行MATCH以相等的概率得到1 or 4 。
同样，如果你从{1,1,1,1}开始，它将被转换为{0,0.25,0.5,0.75,1}并以相等的概率返回1, 2, 3 or 4任何一个。
另外请注意：如果将Application.Sum(v)的值保存在一个variables中，而不是对数组v每个值执行计算，您可能会更快一些。
更新
该函数现在将v作为参数 – 就像您的代码一样。 我也调整了一下，以便它可以处理v有任何基地，这意味着你可以从工作表中运行它：例如=Probable({1,0,0,1})例如
按照你的逻辑，这是我build立的东西。 它工作得很好，提供不同的结果。
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
关于你的情况，确保数组是sorting的。 例如，在我的情况下谈到varLngInputChances 。 我没有看过angular落的情况，可能有错误。
运行TestMe子。 它会产生一个结果摘要。 如果将变化更改为varLngInputChances = Array(1, 1, 0, 0, 1) ，则会给出：
a ===> 329 b ===> 351 e ===> 320
这是相当不错的随机:)你可以在这里改变样本的数量： For lng = 1 To 1000 ，它的工作相当快。 我刚刚尝试了100,000次testing。
看来我犯了一个悲剧性的错误。 我的代码很好，我的计数不是很好。 我在图表中使用了SUMIF()而不是COUNTIF() ，导致后面的数组中的对象（具有更高的索引 – UDF的输出，我本应该计算，而是求和）得到的权重成比例他们的位置。
回想起来，我认为有人比我更聪明，可以根据所提供的信息推断出来。 我说{1,1,1,1} {10%:20%:30%:40%}是{10%:20%:30%:40%} ，这个比例是{1：2：3：4}产出，扣除：产出总计不计。
类似地， {1,0,0,1}图的{1,0,0,1} {20%:0%:0%:80%}输出很好地将每个百分比除以指数（20％/ {1,0,0,1} ％/ 4） 嘿Presto {20%:0%:0%:20%} ，或我预期的1：1比率。
有些恼人的事情，但令人满意的 – 知道答案一直在那里。 我想这可能是道德的。 至less这个职位可以作为一个警告新芽VBAers检查他们的算术。