1000个对象，每个对象最少被抽中一次需要的总抽取次数

zxx993

要求模拟10万次，自己做的抽1万次就卡住了，求高手给个能模拟10万次的方法。


Sub getcatd()

Dim card(1 To 1000) As Integer
Dim m As Integer
Dim count As Long
count = 0

Dim z As Long
For z = 1 To 10 '控制模拟次数

Dim intI As Integer '重置卡池标记
For intI = 1 To 1000
card(intI) = 0
Next


Do

Dim y As Integer
y = Int(Rnd * 1000 + 1) '抽到卡牌
If card(y) = 0 Then card(y) = 1 '标记卡牌已抽过
count = count + 1 '计数增加

m = 0
Dim n As Integer
For n = 1 To 1000
m = m + card(n)
Next

Loop While m < 1000 '所有卡牌已标记，本次模拟结束

Next

MsgBox (Int(count / z)) '输出模拟平均值

End Sub

northwolves

1000个对象全部抽到的期望值为1000*(1/1+1/2+1/3+...+1/999+1/1000)≈1000(ln1000+0.5772)≈7485

模拟10万次,估计也得7.485亿次，看你的CPU了

northwolves

变量尽量定义成Long类型，否则运算时还需要Integer---->Long类型的转换，影响效率

northwolves

供参考：

1. Sub getcatd()
   
2.     Dim times&, s&, i&, k&, n&, card&(), t!
   
3.     times = 10000
   
4.     n = 1000
   
5.     Randomize
   
6.     t = Timer
   
7.     For i = 1 To times
   
8.         ReDim card&(n)
   
9.         While card(n) < n
   
10.             k = Int(Rnd * n)
    
11.             If card(k) = 0 Then card(n) = card(n) + 1
    
12.             card(k) = 1
    
13.             s = s + 1
    
14.         Wend
    
15.     Next
    
16.     MsgBox Int(s / times), , Timer - t & " seconds"
    
17. End Sub

复制代码

zxx993

northwolves 发表于 2022-12-5 22:03
供参考：

感谢