[已解决]用VBA数组随机模拟硬币正反面出现次数

laoau138

用VBA数组随机模拟硬币正反面出现次数


用VBA随机函数模拟硬币，出现两个面都是正面，两个面都是反面，一正一反这3种情况各出现多少次

最佳答案

月排行榜 / 总排行榜

grf1973

2017-5-2 21:04

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For i = 1 To 100
   
4.         p = Int(Rnd * 2 + 1) '生成1--2的随机数
   
5.         x1 = IIf(p = 1, "正面", "反面")
   
6.         p = Int(Rnd * 2 + 1) '生成1--2的随机数
   
7.         x2 = IIf(p = 1, "正面", "反面")
   
8.         x = IIf(x1 <> x2, "一正一反", "两个" & x1)
   
9.         d(x) = d(x) + 1
   
10.         Cells(i + 1, 1) = i
    
11.         Cells(i + 1, 2) = x
    
12.     Next
    
13.     [d2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
14. End Sub
    

复制代码

跳转到最佳答案楼层

france723

我把你的意思理解成, 每次投掷两个硬币, 每次有三个结果 (两正,两反,一正一反) ,投掷若干次.个人电脑问题代码中无法输入汉字.

1. Sub aaa()
   
2. Dim a&, i&, ar, br, s1, s2, s3
   
3. a = InputBox("How many times?")
   
4. ReDim ar(1 To a)
   
5. ReDim br(1 To a)
   
6. For i = 1 To a
   
7.     ar(i) = IIf(Rnd <= 0.5, 0, 1)
   
8.     br(i) = IIf(Rnd <= 0.5, 0, 1)
   
9.     If ar(i) = 0 Then
   
10.         If br(i) = 0 Then
    
11.             s1 = s1 + 1
    
12.         Else
    
13.             s3 = s3 + 1
    
14.         End If
    
15.     Else
    
16.         If br(i) = 1 Then
    
17.             s2 = s2 + 1
    
18.         Else
    
19.             s3 = s3 + 1
    
20.         End If
    
21.     End If
    
22. Next i
    
23. MsgBox ("2obverse: " & s1 & " 2back: " & s2 & " 1o1b: " & s3)
    
24. End Sub

复制代码

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For i = 1 To 100
   
4.         p = Int(Rnd * 2 + 1) '生成1--2的随机数
   
5.         x1 = IIf(p = 1, "正面", "反面")
   
6.         p = Int(Rnd * 2 + 1) '生成1--2的随机数
   
7.         x2 = IIf(p = 1, "正面", "反面")
   
8.         x = IIf(x1 <> x2, "一正一反", "两个" & x1)
   
9.         d(x) = d(x) + 1
   
10.         Cells(i + 1, 1) = i
    
11.         Cells(i + 1, 2) = x
    
12.     Next
    
13.     [d2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
14. End Sub
    

复制代码