1 问题
一个不放回的抽奖用VBA怎么写，下面用一个类似对对碰/ 翻牌子的游戏（抽到的奖励不放回，可抽的东西越来越少）来举例说明
1.1 首先要回顾下几个经典的随机模型
- 古典概型，重点就是每次抽奖的各个奖品，概率都相等。一般就是丢骰子，丢硬币是典型的古典概型
- 丢骰子
- 丢硬币
- N重伯努利试验，重点是每次试验概率稳定不变，其中二项分布等都是属于N重伯努利试验
- 0-1分布
- 几何分布
- 二项分布
- 不放回抽样，抽奖，重点是抽奖后会影响样本总量，进而影响概率，也就是每次抽奖概率都在变化
- 超几何分布
那么，我这里要试验的不放回的抽奖，就需要用到超几何分布的概率计算
1.2 一种比较类似 对对碰 /翻牌的游戏，但规则并不完全相同
- 首先，这个游戏和普通的对对碰游戏不一样，以下是规则
- 游戏开始时是这些牌是盖着的/翻牌/正面遮挡的，需要猜
- 假如有这么一个对对碰游戏，一共有12个奖励，其实是6对图形组成
- 每次翻开就明牌了，如果过程中有任何两张牌相同则获得奖励
- 有个大奖，比如，三眼外星人是大奖！
- 然后继续翻牌，一直玩到游戏结束才能开始下一局
- 这个算是不放回的抽奖
1.2 VBA模拟这个过程和统计奖励结果
- 计算其中如果有大家，那大奖的中奖情况如何
- 顺便计算下其他的奖励情况
2 第一版基础代码
2.1 下面是基础代码
- 单次抽奖部分，单次抽奖，随机结果
- 单次抽奖--全部抽完循环，循环到把所有的牌都翻了
- 外层循环，做N轮的测试，看看平均的数据统计
'2个奇怪问题，一个是，sh.range() 报错，而 range()不报错
'一个是，arr1() 找不到为空，但是arrs1=arr1() 后就可以。
'第一版
'Public arr1()
Private maxcount1
Private n
Public arrs1()
Public arrs2()
Public arrs()
Private s1
Private s2
Sub ChooseCard2()
Dim sh1 As Object
Set sh1 = ThisWorkbook.Worksheets("模拟")
c101 = Application.Match("第1次出现次数均值", sh1.Rows("1:1"), 0)
c102 = Application.Match("第2次出现次数均值", sh1.Rows("1:1"), 0)
c103 = Application.Match("试验次数", sh1.Rows("1:1"), 0)
c104 = Application.Match("牌数1大奖第1次出现次数", sh1.Rows("1:1"), 0)
c105 = Application.Match("牌数1大奖第2次出现次数", sh1.Rows("1:1"), 0)
c106 = Application.Match("牌数2小奖第1次出现次数", sh1.Rows("1:1"), 0)
c107 = Application.Match("牌数2小奖第2次出现次数", sh1.Rows("1:1"), 0)
c108 = Application.Match("牌数3第1次出现次数", sh1.Rows("1:1"), 0)
c109 = Application.Match("牌数3第2次出现次数", sh1.Rows("1:1"), 0)
c110 = Application.Match("牌数4第1次出现次数", sh1.Rows("1:1"), 0)
c111 = Application.Match("牌数4第2次出现次数", sh1.Rows("1:1"), 0)
'初始化等
s11 = 0
s12 = 0
n = sh1.Cells(2, 10)
'还需要清空，复用的输出区域
sh1.Range(sh1.Cells(2, c103), sh1.Cells(9999, c111)).Clear
'测试多轮
For i = 1 To n
Debug.Print "第" & i & "轮开始"
Call load1(n)
sh1.Cells(i + 1, c103) = "第" & i & "次试验"
sh1.Cells(i + 1, c104) = arrs1(1) '改成arr1(1,7)就不行，奇怪
sh1.Cells(i + 1, c105) = arrs2(1) '改成arr1(1,8)就不行
sh1.Cells(i + 1, c106) = arrs1(2)
sh1.Cells(i + 1, c107) = arrs2(2)
sh1.Cells(i + 1, c108) = arrs1(3)
sh1.Cells(i + 1, c109) = arrs2(3)
sh1.Cells(i + 1, c110) = arrs1(4)
sh1.Cells(i + 1, c111) = arrs2(4)
s11 = s11 + arrs1(1) '第1个道具
s12 = s12 + arrs2(1) '第1个道具
s21 = s21 + arrs1(2)
s22 = s22 + arrs2(2)
'第3和第4个道具，用来对比一下，应该是均匀的，理论上8个道具都可以统计起来
s31 = s31 + arrs1(3)
s32 = s32 + arrs2(3)
s41 = s41 + arrs1(4)
s42 = s42 + arrs2(4)
Next
sh1.Cells(2, c101) = s11 / n '需要空1行, 想改成arr1(1, 11) 也不行
sh1.Cells(2, c102) = s12 / n
sh1.Cells(3, c101) = s21 / n
sh1.Cells(3, c102) = s22 / n
sh1.Cells(4, c101) = s31 / n
sh1.Cells(4, c102) = s32 / n
sh1.Cells(5, c101) = s41 / n
sh1.Cells(5, c102) = s42 / n
' 这一堆应该写成函数
Debug.Print n & "轮 对对碰式抽奖 全部循环结束"
Debug.Print "牌面显示为1的道具第1次出现的次数之和=" & s11, '这些如果想用循环，而不是这样写，就应该存在数组里而不是用单个的变量，变量有点类EXCEL单元格的意思
Debug.Print "牌面显示为1的道具第1次出现的平均次数=" & s11 / n
Debug.Print "牌面显示为1的道具第2次出现的次数之和=" & s12,
Debug.Print "牌面显示为1的道具第2次出现的平均次数=" & s12 / n
Debug.Print "牌面显示为2的道具第1次出现的次数之和=" & s21,
Debug.Print "牌面显示为2的道具第1次出现的平均次数=" & s21 / n
Debug.Print "牌面显示为2的道具第2次出现的次数之和=" & s22,
Debug.Print "牌面显示为2的道具第2次出现的平均次数=" & s22 / n
Debug.Print "牌面显示为3的道具第1次出现的次数之和=" & s31,
Debug.Print "牌面显示为3的道具第1次出现的平均次数=" & s31 / n
Debug.Print "牌面显示为3的道具第2次出现的次数之和=" & s32,
Debug.Print "牌面显示为3的道具第2次出现的平均次数=" & s32 / n
Debug.Print "牌面显示为4的道具第1次出现的次数之和=" & s41,
Debug.Print "牌面显示为4的道具第1次出现的平均次数=" & s41 / n
Debug.Print "牌面显示为4的道具第2次出现的次数之和=" & s42,
Debug.Print "牌面显示为4的道具第2次出现的平均次数=" & s42 / n
Debug.Print
End Sub
Function load1(n) '参数n 生命为private还不行？非得要引用参数才可以？
Dim sh1 As Object
Set sh1 = ThisWorkbook.Worksheets("模拟")
c1 = Application.Match("牌数", sh1.Rows("1:1"), 0)
c2 = Application.Match("ID", sh1.Rows("1:1"), 0) '这里的id可以重复，无法作为唯一区别
c3 = Application.Match("名称", sh1.Rows("1:1"), 0)
c4 = Application.Match("数量", sh1.Rows("1:1"), 0)
c5 = Application.Match("权重", sh1.Rows("1:1"), 0)
c6 = Application.Match("牌面", sh1.Rows("1:1"), 0)
maxcount1 = sh1.Cells(999, c1).End(xlUp).Row - 1
Debug.Print "maxcount1=" & maxcount1
Dim sh2 As Object
Set sh2 = ThisWorkbook.Worksheets("模拟")
Dim arr1()
''''' arr1 = sh1.Range("b2:z99") '不能随便乱扩大区域，区域里可能有其他数据，导致数组计算出错，因为后面用倒了6列之外的计算
ReDim arr1(1 To maxcount1 - 1, 1 To 6) '数据能包含表头吗？用的是相当行数/列数
arr1() = Range(sh1.Cells(2, 2), sh1.Cells(maxcount1 + 1, 7)) '这个必须是绝对位置，不是相对行列数，是第N行 如果是sh1.Cells(maxcount1, 7))则错误
'arr1() = Range("b2:g13") '为啥加上sh1.range() 就变成类型不匹配？
'这里写固定的range("b2:g13")还是不好,一旦原数据改了这里就需要手动改
'arrg当中奖标识数组用，新数组
Dim arrg()
ReDim Preserve arrg(1 To maxcount1)
Debug.Print "arrg()=";
For i = 1 To maxcount1
arrg(i) = 1
Debug.Print arrg(i);
Next
Debug.Print ""
Dim arrs()
ReDim arrs(1 To maxcount1)
For m = 1 To maxcount1 '假设玩家需要全部抽完，只方便分析这种情况,这里应该是maxcount1 而不是写死的数字12等
Debug.Print "本轮第" & m & "次抽奖" & Chr(9);
'总权重也要考虑动态
'生成累计权重数组
Dim arr3()
ReDim arr3(1 To maxcount1)
arr3(1) = arr1(1, 5) * arrg(1)
For i = 2 To maxcount1
arr3(i) = arr3(i - 1) + arr1(i, 5) * arrg(i)
Next
'开始单次抽奖随机
Randomize
' 这里权重从0开始，权重对应 0-最大权重p1
pp1 = Int(0 + (arr3(maxcount1) - 0 + 1) * Rnd()) '(p1 - 0 + 1) * Rnd()
Debug.Print "pp1= " & pp1,
'用数组循环+if，需要代替if矩阵判断，另外每个单独累计权重判断也要考虑动态
For i = 1 To maxcount1
If pp1 <= arr3(i) Then
arrg(i) = 0
Debug.Print "获得序号" & i & "的奖励",
arrs(m) = arr1(i, 1)
Debug.Print "牌面是" & Application.Index(sh1.Columns(c6), Application.Match(arrs(m), sh1.Columns(c1), 0))
Exit For '避免符合条件后面的也跟着都符合，无意义
End If
Next
Next
'没把结果数据存在arrs，而是存在了arr1里 合适吗？
'arrs只存一个索引就可以了 arr1是个天然的查询表
'这个要注意，就是只根据牌面查出现得第几次，而不是根据派本身ID或序号取查找，因为对玩家来说两张牌没有先后次序之分
ReDim Preserve arr1(1 To maxcount1, 1 To 12)
For j = 1 To maxcount1
a = 1
For i = 1 To maxcount1
If Application.Index(sh1.Columns(c6), Application.Match(arrs(i), sh1.Columns(c1), 0)) = arr1(j, 6) Then
'Debug.Print "牌面" & arrw(i) & "第" & a & "次出现的次数是：" & i
arr1(j, 7 + a - 1) = i
a = a + 1
End If
Next
Next
Debug.Print
'和上面的循环写成1个应该是可与的把
ReDim Preserve arr1(1 To maxcount1, 1 To 12)
' ReDim Preserve arr1(maxcount1, 12) '这样不行
For j = 1 To maxcount1
arr1(j, 9) = arr1(j, 7) + arr1(j, 9)
arr1(j, 10) = arr1(j, 8) + arr1(j, 10)
arr1(j, 11) = arr1(j, 9) / n
arr1(j, 12) = arr1(j, 10) / n
' 居然直接读 arr1(1,1)或者arr1(1,7)都不行，暂时只好用其他数组倒了一手
ReDim Preserve arrs1(1 To maxcount1)
ReDim Preserve arrs2(1 To maxcount1)
' 牌数1的
arrs1(j) = arr1(j, 7) 'arr1(j, 7) + arrs1(j)
arrs2(j) = arr1(j, 8) 'arr1(j, 8) + arrs2(j)
Next
Debug.Print
End Function
第1轮开始
maxcount1=12
arrg()= 1 1 1 1 1 1 1 1 1 1 1 1
本轮第1次抽奖 pp1= 239 获得序号10的奖励 牌面是4
本轮第2次抽奖 pp1= 267 获得序号12的奖励 牌面是6
本轮第3次抽奖 pp1= 234 获得序号11的奖励 牌面是5
本轮第4次抽奖 pp1= 73 获得序号4的奖励 牌面是4
本轮第5次抽奖 pp1= 78 获得序号5的奖励 牌面是5
本轮第6次抽奖 pp1= 37 获得序号3的奖励 牌面是3
本轮第7次抽奖 pp1= 65 获得序号6的奖励 牌面是6
本轮第8次抽奖 pp1= 91 获得序号9的奖励 牌面是3
本轮第9次抽奖 pp1= 40 获得序号7的奖励 牌面是1
本轮第10次抽奖 pp1= 34 获得序号2的奖励 牌面是2
本轮第11次抽奖 pp1= 21 获得序号8的奖励 牌面是2
本轮第12次抽奖 pp1= 3 获得序号1的奖励 牌面是1
第2轮开始
maxcount1=12
arrg()= 1 1 1 1 1 1 1 1 1 1 1 1
本轮第1次抽奖 pp1= 126 获得序号6的奖励 牌面是6
本轮第2次抽奖 pp1= 234 获得序号11的奖励 牌面是5
本轮第3次抽奖 pp1= 19 获得序号2的奖励 牌面是2
本轮第4次抽奖 pp1= 125 获得序号8的奖励 牌面是2
本轮第5次抽奖 pp1= 40 获得序号3的奖励 牌面是3
本轮第6次抽奖 pp1= 91 获得序号9的奖励 牌面是3
本轮第7次抽奖 pp1= 74 获得序号7的奖励 牌面是1
本轮第8次抽奖 pp1= 79 获得序号10的奖励 牌面是4
本轮第9次抽奖 pp1= 10 获得序号1的奖励 牌面是1
本轮第10次抽奖 pp1= 7 获得序号4的奖励 牌面是4
本轮第11次抽奖 pp1= 1 获得序号5的奖励 牌面是5
本轮第12次抽奖 pp1= 28 获得序号12的奖励 牌面是6
第3轮开始
maxcount1=12
arrg()= 1 1 1 1 1 1 1 1 1 1 1 1
本轮第1次抽奖 pp1= 220 获得序号9的奖励 牌面是3
本轮第2次抽奖 pp1= 183 获得序号8的奖励 牌面是2
本轮第3次抽奖 pp1= 90 获得序号4的奖励 牌面是4
本轮第4次抽奖 pp1= 175 获得序号11的奖励 牌面是5
本轮第5次抽奖 pp1= 48 获得序号3的奖励 牌面是3
本轮第6次抽奖 pp1= 93 获得序号6的奖励 牌面是6
本轮第7次抽奖 pp1= 66 获得序号7的奖励 牌面是1
本轮第8次抽奖 pp1= 89 获得序号10的奖励 牌面是4
本轮第9次抽奖 pp1= 3 获得序号1的奖励 牌面是1
本轮第10次抽奖 pp1= 28 获得序号5的奖励 牌面是5
本轮第11次抽奖 pp1= 41 获得序号12的奖励 牌面是6
本轮第12次抽奖 pp1= 25 获得序号2的奖励 牌面是2
第4轮开始
maxcount1=12
arrg()= 1 1 1 1 1 1 1 1 1 1 1 1
本轮第1次抽奖 pp1= 26 获得序号2的奖励 牌面是2
本轮第2次抽奖 pp1= 78 获得序号5的奖励 牌面是5
本轮第3次抽奖 pp1= 112 获得序号8的奖励 牌面是2
本轮第4次抽奖 pp1= 1 获得序号1的奖励 牌面是1
本轮第5次抽奖 pp1= 68 获得序号6的奖励 牌面是6
本轮第6次抽奖 pp1= 166 获得序号12的奖励 牌面是6
本轮第7次抽奖 pp1= 41 获得序号4的奖励 牌面是4
本轮第8次抽奖 pp1= 82 获得序号10的奖励 牌面是4
本轮第9次抽奖 pp1= 79 获得序号11的奖励 牌面是5
本轮第10次抽奖 pp1= 55 获得序号9的奖励 牌面是3
本轮第11次抽奖 pp1= 16 获得序号3的奖励 牌面是3
本轮第12次抽奖 pp1= 6 获得序号7的奖励 牌面是1
第5轮开始
maxcount1=12
arrg()= 1 1 1 1 1 1 1 1 1 1 1 1
本轮第1次抽奖 pp1= 73 获得序号4的奖励 牌面是4
本轮第2次抽奖 pp1= 254 获得序号12的奖励 牌面是6
本轮第3次抽奖 pp1= 0 获得序号1的奖励 牌面是1
本轮第4次抽奖 pp1= 235 获得序号11的奖励 牌面是5
本轮第5次抽奖 pp1= 178 获得序号9的奖励 牌面是3
本轮第6次抽奖 pp1= 33 获得序号3的奖励 牌面是3
本轮第7次抽奖 pp1= 116 获得序号8的奖励 牌面是2
本轮第8次抽奖 pp1= 2 获得序号2的奖励 牌面是2
本轮第9次抽奖 pp1= 27 获得序号5的奖励 牌面是5
本轮第10次抽奖 pp1= 41 获得序号10的奖励 牌面是4
本轮第11次抽奖 pp1= 26 获得序号6的奖励 牌面是6
本轮第12次抽奖 pp1= 7 获得序号7的奖励 牌面是1
5轮 对对碰式抽奖 全部循环结束
牌面显示为1的道具第1次出现的次数之和=30 牌面显示为1的道具第1次出现的平均次数=6
牌面显示为1的道具第2次出现的次数之和=54 牌面显示为1的道具第2次出现的平均次数=10.8
牌面显示为2的道具第1次出现的次数之和=23 牌面显示为2的道具第1次出现的平均次数=4.6
牌面显示为2的道具第2次出现的次数之和=38 牌面显示为2的道具第2次出现的平均次数=7.6
牌面显示为3的道具第1次出现的次数之和=27 牌面显示为3的道具第1次出现的平均次数=5.4
牌面显示为3的道具第2次出现的次数之和=36 牌面显示为3的道具第2次出现的平均次数=7.2
牌面显示为4的道具第1次出现的次数之和=20 牌面显示为4的道具第1次出现的平均次数=4
牌面显示为4的道具第2次出现的次数之和=40 牌面显示为4的道具第2次出现的平均次数=8
3 上面的基础代码需要逐个解决的问题
3.1 未解决
一个是，sh.range() 报错，而 range()不报错
3.2 未解决
一个是，arr1() 找不到为空，但是arrs1=arr1() 后就可以。
3.3
4 优化后的代码
5 具体到超几何分布的概率计算，和 统计数据，统计图
挑选合理数据等
