用Excel写个摸球模拟器玩玩

背景

---

最近对象有个需求，想要帮忙写个程序，实现功能：模拟两种颜色的球，随机摸球N次后，摸到不同颜色的次数。

考虑到非程序员的环境配置问题，直接用Excel中的宏开发模式，把许久前学过的VB语言捡起来，简单实现了下，效果如下：

代码实现

---

实现思路

• 界面区：
  • 设置两种颜色球的个数
  • 设置1000、10000、100000次模拟循环按钮
  • 单元格实时刷新摸球模拟结果，并可视化为进度条
• 代码区：
  • 编写ms级延时函数delay()
  • 编写核心处理函数main_process()，模拟摸球过程
    • 随机函数生成0-1区间的数
    • 根据几何概型将不同类型球的个数转换为概率
    • 统计随机函数生成结果在不同区间的次数，并延时显示到单元格上
  • 不同按钮设置循环次数传递给main_process()
  • 归零按钮实现单元格数据清零

VB代码

Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long

Sub delay(T As Long)
    Dim time1 As Long
    time1 = timeGetTime
    Do
        DoEvents
    Loop While timeGetTime - time1 < T
End Sub

Sub main_process(loop_times As Long)
    red = 4
    yellow = 3
    ratio_red = red / (red + yellow)
    normalised_val = 0
    
    Range("b5").Value = 0
    Range("b6").Value = 0
    
    delay_t = 0
    If looptimes = 1000 Then
      delay_t = 2
    End If
    
    If loop_times = 10000 Then
      delay_t = 1
    Else
      delay_t = 0
    End If
      
    
    For i = 1 To loop_times
    
        If loop_times <> 100000 Then
            delay (delay_t)
        End If
            
        
        normalised_val = Rnd()
        If normalised_val < ratio_red Then
            Range("b5").Value = Range("b5").Value + 1
        Else
            Range("b6").Value = Range("b6").Value + 1
        End If
    Next i
    
End Sub

Sub 按钮1_Click()
    loop_times = 1000
    main_process (loop_times)
End Sub

Sub 按钮2_Click()
    loop_times = 10000
    main_process (loop_times)
End Sub

Sub 按钮3_Click()
    loop_times = 100000
    main_process (loop_times)
End Sub


Sub 按钮4_Click()
    Range("b5").Value = 0
    Range("b6").Value = 0
End Sub

如果有兴趣需要现成的excel文件可以评论留言，有需求再放上来，当然还是鼓励自己去尝试下。

相关资料

---

1. VBA延时的三个方法，link
2. VBA常用函数参考，link