背景

---

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

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

代码实现

---

实现思路

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

VB代码

Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As LongSub delay(T As Long)Dim time1 As Longtime1 = timeGetTimeDoDoEventsLoop While timeGetTime - time1 < T
End SubSub main_process(loop_times As Long)red = 4yellow = 3ratio_red = red / (red + yellow)normalised_val = 0Range("b5").Value = 0Range("b6").Value = 0delay_t = 0If looptimes = 1000 Thendelay_t = 2End IfIf loop_times = 10000 Thendelay_t = 1Elsedelay_t = 0End IfFor i = 1 To loop_timesIf loop_times <> 100000 Thendelay (delay_t)End Ifnormalised_val = Rnd()If normalised_val < ratio_red ThenRange("b5").Value = Range("b5").Value + 1ElseRange("b6").Value = Range("b6").Value + 1End IfNext iEnd SubSub 按钮1_Click()loop_times = 1000main_process (loop_times)
End SubSub 按钮2_Click()loop_times = 10000main_process (loop_times)
End SubSub 按钮3_Click()loop_times = 100000main_process (loop_times)
End SubSub 按钮4_Click()Range("b5").Value = 0Range("b6").Value = 0
End Sub

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

相关资料

---

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