VBA小模板，一个不放回的抽奖用的例子

已于 2023-03-22 18:18:46 修改
阅读量2.2k 收藏 3
点赞数 1
分类专栏： VBA 文章标签： VBA
于 2023-01-11 14:52:26 首次发布
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/xuemanqianshan/article/details/128644071
版权
文章描述了一个使用VBA在Excel中模拟不放回抽奖的过程，涉及超几何分布的概率计算。代码通过循环和数组处理数据，统计各奖项的出现次数和平均值。在代码中，作者遇到了使用工作表对象范围报错和数组引用问题，以及数组和变量的使用优化。经过优化，代码提高了对数据变化的适应性和可读性。

摘要生成于 C知道 ，由 DeepSeek-R1 满血版支持， 前往体验 >

1 问题

       一个不放回的抽奖用VBA怎么写，下面用一个类似对对碰/ 翻牌子的游戏（抽到的奖励不放回，可抽的东西越来越少）来举例说明

1.1 首先要回顾下几个经典的随机模型

  • 古典概型，重点就是每次抽奖的各个奖品，概率都相等。一般就是丢骰子，丢硬币是典型的古典概型
  1. 丢骰子
  2. 丢硬币
  • N重伯努利试验，重点是每次试验概率稳定不变，其中二项分布等都是属于N重伯努利试验
  1. 0-1分布
  2. 几何分布
  3. 二项分布
  • 不放回抽样，抽奖，重点是抽奖后会影响样本总量，进而影响概率，也就是每次抽奖概率都在变化
  1. 超几何分布

那么，我这里要试验的不放回的抽奖，就需要用到超几何分布的概率计算

1.2 一个不放回抽奖的例子：一种比较类似 对对碰 /翻牌的游戏

这个游戏和普通的对对碰游戏不一样，以下是详细规则

  1. 游戏开始时是这些牌是盖着的/翻牌/正面遮挡的，需要猜
  2. 假如有这么一个对对碰游戏，一共有12个奖励，其实是6对图形组成
  3. 每次翻开就明牌了，如果过程中有任何两张牌相同则获得奖励
  4. 有个大奖，比如，三眼外星人是大奖！
  5. 然后继续翻牌，一直玩到游戏结束才能开始下一局
  6. 这个算是不放回的抽奖

1.3 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

2.2  循环查找出现的次数

  • 相当于1个数组，要查里面的元素的是第几次出现的
  • 外层循环，遍历数组（这里这个数组实际是 前面抽奖的结果数组）
  • 内层循环，同1个数组遍历
  •       内层循环，加if判断，如果判断和外层循环的数组某个值相等，则存在第a列
  •       内层循环，加if判断，如果判断和外层循环的数组某个值相等，则存在第a+1列

 '这个要注意，就是只根据牌面查出现得第几次，而不是根据派本身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

3 上面的基础代码需要逐个解决的问题

3.1 未解决1 ：使用sh1.range() 报错，而 range()不报错

  • 使用sh1.range() 报错，而 range()不报错，这个很奇怪
  • 因为 只写 range() 需要保证，当前打开得sheet是 数据所在页，如果切到其他sheet，而其他sheet上没这些数据/ 不同数据，则后面的计算肯定报错
  • 而如果写成sh1.range() ，就可以不用当前sheet 处于active的状态了，这个肯定是更好的代码
  • 但如果写成sh1.range() ，就会报错   “ 类型不匹配  ” ，暂时真的不知道为啥
  • 反而写成 range() 就正常运行

 

3.2 未解决2 :arr1() 找不到为空，但是arrs1=arr1() 后，再引用 arrs1()就可以。

  • arr1() 找不到为空，但是arrs1=arr1() 后，再引用 arrs1()就可以。

  • 现在我的arr1() 已经，扩展 preserve 后，在原数据对应的1-6列之外，新增了7-12列保存了

  1. 第7列，这一轮第1次出现的次数，
  2. 第8列，这一轮第2次出现的次数，
  3. 第9列，第1次出现的累计次数，
  4. 第10列，第2次出现的累计次数，
  5. 第11列，第1次出现的平均次数，
  6. 第12列，第2次出现的平均次数，
  • arrs1(1) 就等于 arr1(i,7)
  • 这些数组，也都尝试过，在代码开头， private arr1(), arrs1(), arrs2()
  • 但是在主循环里，直接读arr1(i,7)等就不行，但是读转了一手的 arrs1(1) 就可以
  • 不知道为啥

4 第一次优化后的代码

4.1 解决了那些问题，如何解决的写在下面详细的

  • 把输出部分都改写成了数组，然后可扩展性变量，不用并列很多行变量重复代码
  • 把可变参数代替了很多写死的地方，比如用 maxcoount1/2 而不是用6 ，代码对数据变化的兼容性提高

'2个奇怪问题，一个是，sh.range() 报错，而 range()不报错
'一个是，arr1() 找不到为空，但是arrs1=arr1() 后就可以。

'第一版



'Public arr1()
Private maxcount1
Private n

Public arrs1()
Public arrs2()
Public arrs()

Private s1
Private s2


Sub ChooseCard3()

    Dim sh1 As Object
    Set sh1 = ThisWorkbook.Worksheets("模拟")

   '注意这些 关键字 字段名 别写错了，如果EXCEL里字段名修改了，这里要同步修改
    c1 = Application.Match("牌数", sh1.Rows("1:1"), 0)
    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)
'    c112 = Application.Match("牌数5第1次出现次数", sh1.Rows("1:1"), 0)
'    c113 = Application.Match("牌数5第2次出现次数", sh1.Rows("1:1"), 0)
'    c114 = Application.Match("牌数6第1次出现次数", sh1.Rows("1:1"), 0)

    c115 = Application.Match("牌数6第2次出现次数", sh1.Rows("1:1"), 0)
    
    '赋值，excel里填循环次数，方便用户操作
     n = sh1.Cells(2, 10)
     maxcount1 = sh1.Cells(999, c1).End(xlUp).Row - 1
     
    
    '初始化
    s11 = 0
    s12 = 0
    '还需要清空，复用的输出区域
    '首行首列一般不变，但是最后1行1列常变，c115这里最好动态，最后不要写死行数，修改起来更麻烦
    sh1.Range(sh1.Cells(2, c103), sh1.Cells(9999, c115)).Clear
    
    
    '测试多轮
    For i = 1 To n
        Debug.Print "第" & i & "轮开始"
        Call load1(n)
        
        '从第2行开始录入数据
         sh1.Cells(i + 1, c103) = "第" & i & "次试验"
        '从第2行开始录入数据,行数跟着大循环走，6是奖励种类  6=maxcount1 / 2,这里最好不要用数字6，写参数更灵活
         For j = 1 To maxcount1 / 2
           '从第12行开始输入，虽然12=c013,但是写成参数更好，c103--指向开始的那1列的前1列：试验次数
           sh1.Cells(i + 1, c103 + 2 * j - 1) = arrs1(j)
           sh1.Cells(i + 1, c103 + 2 * j) = arrs2(j)
         Next

         '直接 a=a+ i 这样就可以做累积arr2(i) = arrs1(i) + arr2(i) ，不需要单独定义i=1时的起始数，确实可以
         '把均值，累计值全给存下来
         '这段得放循环里，如果放循环外面只会存最后1次的数据，因为每次循环开始前上一轮数据清空了
         Dim arr2()
         ReDim Preserve arr2(1 To 12, 1 To 2)   '如果这之前没有数据Preserve没意义,每次循环有则需要保存之前的数据
         For k = 1 To 12
            arr2(k, 1) = arrs1(k) + arr2(k, 1)     'arrs1(k) 想改成arr1(1, 11) 不行?
            arr2(k, 2) = arrs2(k) + arr2(k, 2)
            
            sh1.Cells(k + 1, 8) = arr2(k, 1) / n
            sh1.Cells(k + 1, 9) = arr2(k, 2) / n
         Next
      Next
    
    '循环结束后做下总结就可以了，不用写在循环里去浪费
    '这些如果想用循环，而不是这样写，就应该存在数组里而不是用单个的变量，变量有点类EXCEL单元格的意思
    '我现在的认识，数组就是一组变量，就是 多变量集合，就这么简单。而不是单变量。
      Debug.Print
      Debug.Print "总测试轮数=" & n
      For k = 1 To 6
          Debug.Print "牌面显示为" & k & "的道具第1次出现的次数之和=" & arr2(k, 1),         '这里别用变量 s11,用数组arr2(k, 1)，因为变量太多了，变量名有不能带参数
          Debug.Print "牌面显示为" & k & "的道具第1次出现的平均次数=" & arr2(k, 1) / n
          Debug.Print "牌面显示为" & k & "的道具第2次出现的次数之和=" & arr2(k, 2),
          Debug.Print "牌面显示为" & k & "的道具第2次出现的平均次数=" & arr2(k, 2) / n
      Next
      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
        '一定要整数随机？小数随机好像是不是也无所谓？
        '应该要从1开始，既然是整数随机
        
        pp1 = Int(1 + (arr3(maxcount1) - 1 + 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


   For i = LBound(arrs1, 1) To UBound(arrs1, 1)
       Debug.Print "arrs1(" & i & ") =" & arrs1(i),
   Next
   Debug.Print

   For i = LBound(arrs2, 1) To UBound(arrs2, 1)
       Debug.Print "arrs2(" & i & ") =" & arrs2(i),
   Next
   Debug.Print


End Function

4.2  能参数的都用参数，避免写死

    '初始化
    s11 = 0
    s12 = 0
    '还需要清空，复用的输出区域
    '首行首列一般不变，但是最后1行1列常变，c115这里最好动态，最后不要写死行数，修改起来更麻烦
    sh1.Range(sh1.Cells(2, c103), sh1.Cells(9999, c115)).Clear
    
    
    '测试多轮
    For i = 1 To n
        Debug.Print "第" & i & "轮开始"
        Call load1(n)
        
        '从第2行开始录入数据
         sh1.Cells(i + 1, c103) = "第" & i & "次试验"
        '从第2行开始录入数据,行数跟着大循环走，6是奖励种类  6=maxcount1 / 2,这里最好不要用数字6，写参数更灵活
         For j = 1 To maxcount1 / 2
           '从第12行开始输入，虽然12=c013,但是写成参数更好，c103--指向开始的那1列的前1列：试验次数
           sh1.Cells(i + 1, c103 + 2 * j - 1) = arrs1(j)
           sh1.Cells(i + 1, c103 + 2 * j) = arrs2(j)
         Next

4.2.1 这里不写死的几个例子

下面拿出来看

1

    '首行首列一般不变，但是最后1行1列常变，c115这里最好动态，最后不要写死行数，修改起来更麻烦
    sh1.Range(sh1.Cells(2, c103), sh1.Cells(9999, c115)).Clear

2

'c103--指向开始的那1列的前1列：试验次数
         sh1.Cells(i + 1, c103) = "第" & i & "次试验"

3 比如用 maxcoount1/2 而不是用6 ，代码对数据变化的兼容性提高

 '从第12行开始输入，虽然12=c013,但是写成参数更好，c103--指向开始的那1列的前1列：试验次数
         For j = 1 To maxcount1 / 2
         

4.2.2 写死的坏处

  • 1 变量名的可读性比数字等可读性更强
  • 如果上面这些可参数的地方都写死，将来需要改的时候，就得 改这些数字6 ，12之类得，你也很难记得这些数字得意义，
  • 如果很多地方都是一样的数字，比如最大行数，你写12，很多地方都引用了12，一旦行数变化为16等你就得1个1个改，而且还容易漏改等错误

4.2.3 不写死，用参数的好处

  1. 代码对数据变化的兼容性提高
  2. 如果这个数据出现多次，用变量控制，可以只改1个地方而全改，方便
  3. 如果这个数据出现多次，用变量控制，可以只改1个地方而全改，避免不同的地方有的改了有的没改，造成错误

4.3 数组替换变量的部分，用循环

  • 下面这段代码和更下面被注释掉的代码，对比
  • 用数组存储多个数据，比用变量方便很多
        '从第2行开始录入数据
         sh1.Cells(i + 1, c103) = "第" & i & "次试验"
        '从第2行开始录入数据,行数跟着大循环走，6是奖励种类  6=maxcount1 / 2,这里最好不要用数字6，写参数更灵活
         For j = 1 To maxcount1 / 2
           '从第12行开始输入，虽然12=c013,但是写成参数更好，c103--指向开始的那1列的前1列：试验次数
           sh1.Cells(i + 1, c103 + 2 * j - 1) = arrs1(j)
           sh1.Cells(i + 1, c103 + 2 * j) = arrs2(j)
         Next
         
          '下面这种被注掉的，多变量的赋值写法真的需要改成数组赋值的方法，1代码少，2方便可扩展
'         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)

4.3.1  什么时候该用变量，什么时候该用数组，存储数据？

  • 这些如果想用循环，而不是写成多个变量赋值语句，就应该存在数组里而不是用单个的变量
  • 因为变量名是没法带参数的！如果想让多个变量有规律的操作，存储就应该用数组

4.3.2 变量 和数组，分别可类似于 excel里的 单元格  和区域

  • 变量有点类excel的单元格，数组就是excel里的 区域
  • 我现在的认识，数组就是一组变量，就是 多变量集合，就这么简单。而不是单变量。
  • 简单的来说，
  1. 如果只想存储1个数据就用变量
  2. 如果想存储多个数据就用数组
  3. 如果想把多个数据存在一起，方便一起读写，那也要用数组

4.3.3  用数组来存储多个变量，还有很多好处

  • 笨办法： 用多个变量，来存储多个数据 （因为变量名是没法带参数的！）
  • 好办法： 用数组来存储多个数据
  1. 用数组来做，代码少，精简
  2. 用数组来写，更方便，数组更好扩展

  

4.3.4  使用数组和EXCEL数据要特别注意：不要随便扩大数组的范围

  • 不要随便扩大数组的范围
  • 很多时候，随意扩大数组范围，是为了取巧，避免后面的数组 使用时index 越界太小，但这样不好
  • 比如不要随便扩大数组的范围，经常会出意想不到的问题
  • arr1 = Range("b2:g13")   写成 arr1 = sh1.Range("b2:z99")   这样不好，不能随便乱扩大区域，区域里可能有其他数据，导致数组计算出错

4.3.5   使用数组和EXCEL数据要特别注意：数组内容，一般不能包含表头的

  • 数据能包含表头吗？一般最好不要包括，
  • 用的是相当行数/列数，纯数据
  •  ReDim arr1(1 To maxcount1 - 1, 1 To 6)                                

     

4.3.6   数组和EXCEL数据 表达方法 尤其 行列数写法有差别，要小心！

  • 数组只要 行数和列数 ，比如 ReDim arrs(1 To maxcount1)
  • 而EXCEL 表示一个范围range("" )要的是 第N行和第 M列，用的是绝对行数和绝对列数

举例1

Dim arrs()
ReDim arrs(1 To maxcount1)

举例2 

arr1() = Range(sh1.Cells(2, 2), sh1.Cells(maxcount1 + 1, 7))    '这个必须是绝对位置，

4.3.7 简单的单数双数的写法

  • + 2*j-1   单数步，增大
  • + 2*j      双数步，增加

for i = 1 to 6

     cells(2,2j-1)=1

     cells(2,2j) =i

next

4.4  循环累计这段代码

下面这段代码的目标

  • 首先，Dim arr2()这段代码，是为了做计算累积，然后计算累计值的平均值
  • 每轮循环的时候，把这一轮的值全部存在数组里，下一轮的时候，把新的数值，再加到之前的数组的老值上面。需要注意使用 redim preserve 才行
  • 虽然这里，累计值需要在每个循环内都计数累计，但是平均值其实可以最后再算，当然中间每个循环都算，一直在变也还好（除非特别追求运行效率）

4.4.1   redim preserve的用法

  • 需要注意使用 redim preserve 才行
  1. redim preserve 并不能保证preserve 全部数据，前提是，数组循环时不要因为 行列变化，切割原数组，index从大变小的时候丢失数据
  2. redim preserve 只能最后1维变化，而且一般来说，只适合最后1维从小变大！否则还是会丢数据
  3. redim preserve 之前注意是否有数据，否则没必要
  4. redim preserve arr1() 只支持动态数组，需要先定义为动态数组才可以，静态数组和变量都不行

4.4.2 循环累计的写法

  • 直接 a=a+ i 这样就可以做累积，类似，a=a+ 也不需要先定义 a=1怎么样，再来a=a+
  • 所以数组也是一样  arr2(i) = arrs1(i) + arr2(i)   不需要像我以前一样特别的单独定义i=1时的起始数

4.4.3  需要理解循环的用法，注意到这段代码放那一层循环合适

  • 这段得放 fo  i = 1 to n 这个多轮循环里，如果放循环外面只会存最后1次的数据
  • 因为每次循环开始前上一轮数据清空了，在循环外就没法累计，只能得到最后1轮的数据

    For i = 1 To n
        Debug.Print "第" & i & "轮开始"
        Call load1(n)
        
        '从第2行开始录入数据
         sh1.Cells(i + 1, c103) = "第" & i & "次试验"
        '从第2行开始录入数据,行数跟着大循环走，6是奖励种类  6=maxcount1 / 2,这里最好不要用数字6，写参数更灵活
         For j = 1 To maxcount1 / 2
           '从第12行开始输入，虽然12=c013,但是写成参数更好，c103--指向开始的那1列的前1列：试验次数
           sh1.Cells(i + 1, c103 + 2 * j - 1) = arrs1(j)
           sh1.Cells(i + 1, c103 + 2 * j) = arrs2(j)
         Next

        
         '直接 a=a+ i 这样就可以做累积arr2(i) = arrs1(i) + arr2(i) ，不需要单独定义i=1时的起始数，确实可以
         '把均值，累计值全给存下来
         '这段得放循环里，如果放循环外面只会存最后1次的数据，因为每次循环开始前上一轮数据清空了
         Dim arr2()
         ReDim Preserve arr2(1 To 12, 1 To 2)   '如果这之前没有数据Preserve没意义,每次循环有则需要保存之前的数据
         For k = 1 To 12
            arr2(k, 1) = arrs1(k) + arr2(k, 1)     'arrs1(k) 想改成arr1(1, 11) 不行?
            arr2(k, 2) = arrs2(k) + arr2(k, 2)
            
            sh1.Cells(k + 1, 8) = arr2(k, 1) / n
            sh1.Cells(k + 1, 9) = arr2(k, 2) / n
         Next
      Next

5 具体到超几何分布的概率计算，和 统计数据，统计图

5.1 下面是假设6种奖励，12张牌面抽奖的统计次数

  • 因为前面代码里我写了 可以循环 N 轮，所以可以得到多轮的数据
  • 然后从多轮的数据里，我们可以看各种平均数
  • 算术平均数： 总累计数/次数，一旦差异大就不太准
  • 中位数：数组序列，最靠中间的那1，2个数
  • 众数，数组里出现最多的数 （表示  相对多数人会遇到的情况，但是如果是一个长尾，可能会代表性不强）

5.2  所以除了看这几个平均数还不够，还需要结合，数组序列的整体分布情况来一起分析

  • 如果数组序列，整体比较稳，差异不大，也许 算术平均数更好
  • 甚至可以考虑，几何平均数，加权平均数等等
  • 如果数组序列，就是一个大头部，且头部比较平，那也许众数有代表性
  • 如果数组序列，散点波动大，可能就得考虑 中位数等， 

  • 这次跑得情况是
  • 第1次出现得众数有代表性，第2次出现曲线波动大看看算术平均数

5.3 是否可以进一步统计  收益/成本 核算？

  • 因为有了次数，也有单次成本，所以统计总成本是比较容易得
  • 需要统计总收益
  • 总收益标准1：计算每个奖励价格*数量，每次中奖收益都有，总收益可计算。需要考虑每个奖励的名义价值 和 实际价值，算2种。
  • 总收益标准2：只算核心的，比如每次普通抽奖都是基本价值对应的，平赚120%，可以接受。所以只要计算核心大奖的 收益 /抽奖成本。那么计算出来的就是，抽奖花多少可以抽到多少个大奖

6 其他问题

6.1  考虑是否可以写一个客户端表现过程出来

  • 现在只有抽奖逻辑，考虑是否可以写一个客户端表现过程出来
  • 根据参数实现，不同的牌和桌面效果
  • 每次翻牌，翻牌了的就放在桌子右边，没有的继续放原处

评论 1
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值