前两期我们搭了一个能用VBA在Excel里抽卡的模拟器：第一期搞清楚了Rnd和Randomize到底怎么用，第二期加了个按钮，单击一下返回SSR/SR/R，旁边还有个计数器在涨。但说实话，那种程度只能叫"能跑"，离"能用"还差得很远。真正的抽卡模拟器要回答三个问题：概率对不对、保底算不算、抽过的数据能不能复盘。这一期，我打算把这三件事全部补齐，顺便聊聊新手在写这类工具时最容易忽略的性能和交互问题。内容有点多，但每一步我都会给出可以直接复制到VBA编辑器里的代码，你跟着敲一遍，收获会比光看大得多。
1. 从单抽骰子到"规则完整"：重新梳理需求边界
1.1 前两期留下的成绩单
第二期结束时，我们的模拟器大概长这样：一个CommandButton，点击触发DrawOnce，用Rnd生成一个0到1之间的小数，根据预设阈值判断稀有度，再把结果显示在某个单元格里。代码量不大，核心逻辑也就十几行，但已经能支撑"抽卡"的基本动作了。
如果你是从第一期跟过来的，应该已经知道Rnd返回的是一个Single类型的小数，范围在[0,1)之间，配合Randomize可以让每次打开工作簿后随机序列不同。第二期的关键点在于把随机数映射到不同稀有度：比如Rnd < 0.012就是SSR，Rnd < 0.07是SR，剩下是R。这个思路没错，只是一旦需求变复杂，直接用硬编码阈值会非常痛苦。
1.2 一个新需求清单
我在写第三期之前，把"一个真正能用的抽卡模拟器"拆成了下面这张需求清单。你可以拿自己的项目对照，缺哪个补哪个：
- 固定概率表，且概率可以在工作表里直接改，而不是每次改代码。
- 支持单抽和十连，十连至少要保证一张SR或以上。
- 有UP池逻辑，同一稀有度下，不同的卡权重不同。
- 有大保底机制，比如累积抽数达到90抽必出SSR。
- 保底计数在关闭Excel再打开后依然有效。
- 每次抽取都写入历史记录，包含时间、抽数、保底状态。
- 有一个统计面板，显示总抽数、已出SSR数量、平均出货间隔、当前距保底还剩多少抽。
- 批量连抽不会让Excel卡死，跑1万次也要在几秒内完成。
这份清单看起来有点吓人，但每一步都不难。难的是你愿意在动手前把它想清楚。很多新手写VBA习惯"开一个按钮就开始填代码"，结果写到一半发现结构不对，全删重来。我踩过这个坑，所以这期会先按需求设计模块，再一一实现。
1.3 为什么"先写需求再写代码"不是废话
你可能觉得，一个抽卡模拟器而已，至于列需求吗？非常至于。因为VBA项目最容易失控的地方不是单点逻辑，而是全局状态。比如保底计数该存在哪、历史记录写在哪张表、统计公式引用哪个区域，这些如果前期没有约定，后面每加一个功能都要回头改几十处。
我的习惯是画一个简单的数据流：按钮 -> 抽取函数 -> 返回结果 -> 更新历史表和统计区 -> 刷新隐藏的保底计数。不画流程图也行，但至少要在脑子里过一遍：哪些数据是临时的，哪些数据需要跨会话保留。临时数据用模块级变量，保留数据用隐藏工作表或自定义属性，后面会专门讲。
2. 概率模型落地：权重表、UP池与十连规则
2.1 区间权重抽卡：先看懂Rnd到底在做什么
第二期的阈值判断有一个隐患：如果概率表改了，比如SSR从1.2%调到2.0%，你得改代码里的两个数字，而且很容易改漏。更灵活的做法是维护一张权重表，用"区间落点"来决定结果。
举个例子，假设SSR权重是12，SR权重是70，R权重是918。总权重就是12+70+918=1000。我们生成一个0到999之间的随机整数，如果落入[0,12)就是SSR，落入[12,82)就是SR，落入[82,1000)就是R。这样调整某个稀有度的概率，只需要改权重表，代码完全不用动。
在VBA里生成0到999的随机整数可以这样写：
Randomize Dim roll As Long roll = Int(Rnd() * 1000)注意Rnd()返回的可能是0，但永远不会是1，所以Int(Rnd() * 1000)的取值范围恰好是0到999，不会出现越界。
2.2 GetRandomRarity函数
为了让后续功能都能复用，我建议把判断稀有度的逻辑单独抽成一个函数。这样不管单抽还是十连，都调用同一个函数，保证概率口径一致。
下面是一个通用版本，稀有度列表和权重都从工作表读取：
Function GetRandomRarity() As String Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("概率表") Dim rarityNames() As String Dim rarityWeights() As Long Dim i As Long, totalWeight As Long ' 假设概率表 A列是稀有度，B列是权重 Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ReDim rarityNames(1 To lastRow - 1) ReDim rarityWeights(1 To lastRow - 1) For i = 1 To lastRow - 1 rarityNames(i) = ws.Cells(i + 1, 1).Value rarityWeights(i) = ws.Cells(i + 1, 2).Value totalWeight = totalWeight + rarityWeights(i) Next i Randomize Dim roll As Long roll = Int(Rnd() * totalWeight) Dim cumulative As Long cumulative = 0 For i = 1 To UBound(rarityNames) cumulative = cumulative + rarityWeights(i) If roll < cumulative Then GetRandomRarity = rarityNames(i) Exit Function End If Next i GetRandomRarity = rarityNames(UBound(rarityNames)) End Function这个函数有几个值得新手注意的点：第一，totalWeight是动态累加的，不需要你在代码里写死；第二，Roll落在哪个区间完全由权重表决定，所以你想把SSR改成SSS级，直接在表里加一行就行；第三，Randomize放在函数内部会让每次调用都重新初始化随机数种子，虽然这里的重复初始化问题不大，但严谨一点的话其实可以把Randomize抽到外部，等性能部分再细说。
2.3 给卡池加入UP标签
真实抽卡除了稀有度，还有"这一包卡里谁是UP"的问题。我们用一个二维结构来表示：先随机稀有度，再在对应稀有度的卡池里随机一张具体卡。每个卡池区域可以维护一个UP权重，让UP卡在中奖后占大概率，但又不至于次次都是它。
假设在"概率表"右侧，某稀有度下面列了具体卡名和权重。比如SSR区域有"伊芙"权重50、"雷恩"权重30、"阿娅"权重20。我们先用上面的GetRandomRarity得到稀有度，再根据这个稀有度去读取对应的卡名列表。
写一个GetRandomCard函数：
Function GetRandomCard(rarity As String) As String Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("卡池") ' 假设卡池表按列存放，第一行是稀有度名称 Dim targetCol As Long targetCol = 0 Dim i As Long For i = 1 To 10 If ws.Cells(1, i).Value = rarity Then targetCol = i Exit For End If Next i If targetCol = 0 Then GetRandomCard = "未找到卡池" Exit Function End If Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, targetCol).End(xlUp).Row Dim totalWeight As Long, j As Long For j = 2 To lastRow totalWeight = totalWeight + ws.Cells(j, targetCol + 1).Value Next j Dim roll As Long Randomize roll = Int(Rnd() * totalWeight) Dim cum As Long cum = 0 For j = 2 To lastRow cum = cum + ws.Cells(j, targetCol + 1).Value If roll < cum Then GetRandomCard = ws.Cells(j, targetCol).Value Exit Function End If Next j GetRandomCard = ws.Cells(lastRow, targetCol).Value End Function这里的布局你可以按自己的喜好调整，核心思路上和稀有度区间完全一致。UP角色为什么做得"概率大但不是必中"？因为权重高，但区间里还有别的卡，随机落在别人身上的概率依然存在。这种设计比写If Rnd < 0.5 Then UP要灵活得多。
2.4 十连抽与"至少一张SR"的保底逻辑
十连看起来就是调用十次单抽，但很多游戏加了"十连保底SR"的规则，意思是如果十连里一次SR都没出，就强制把其中某一抽替换成SR。实现方式也很直接：
Function DrawTen() As String Dim i As Long Dim results As String Dim hasSR As Boolean Dim tempResults(1 To 10) As String Dim rarity As String For i = 1 To 10 rarity = GetRandomRarity() tempResults(i) = GetRandomCard(rarity) results = results & tempResults(i) & " | " If rarity <> "R" Then hasSR = True Next i ' 如果没有SR或以上，把第10抽强制改成SR If Not hasSR Then Dim srCard As String srCard = GetRandomCard("SR") tempResults(10) = srCard results = "十连保底触发：" & srCard End If DrawTen = results End Function注意这里我用了一个tempResults数组暂存结果，而不是直接拼results，这样可以在保底触发时方便地替换某一格。你可以把results直接输出到单元格，也可以转成数组批量写进历史记录表，后者我们会在第四部分详细讲。
2.5 用一万次抽取验证期望值
概率模型对不对，不能靠感觉，要用大量抽取来验证。写一个简单的自检宏，跑一万次单抽，统计每个稀有度的出现次数：
Sub ProbabilityTest() Dim i As Long Dim ssrCount As Long, srCount As Long, rCount As Long Application.ScreenUpdating = False Randomize For i = 1 To 10000 Dim rarity As String rarity = GetRandomRarity() If rarity = "SSR" Then ssrCount = ssrCount + 1 ElseIf rarity = "SR" Then srCount = srCount + 1 Else rCount = rCount + 1 End If Next i Application.ScreenUpdating = True Debug.Print "SSR次数: " & ssrCount Debug.Print "SR次数: " & srCount Debug.Print "R次数: " & rCount End Sub打开VBA编辑器的"立即窗口"（快捷键Ctrl+G）就能看到结果。比如你设定SSR权重是12/1000，那理论上10000次应该出120次左右，实际在110到130之间波动都算正常。如果偏差过大，就要检查权重表有没有写错，或者Randomize放的位置是否导致随机序列有规律。这一步一定不能省，我用这套方法抓出过权重表合计算错导致的概率翻倍问题。
3. 保底机制与状态持久化：临时计数器是不行的
3.1 保底规则怎么设计才合理
保底是抽卡模拟里最有"工程感"的部分，因为涉及跨会话状态。我设计了两个规则，和主流抽卡机制对得上：
- 硬保底：累计90抽必出SSR。如果90抽内提前出了，计数清零。
- 十连软保底：十连结果里如果没有SR或以上，强制替换一张为SR。
你可以把硬保底扩大到180抽必出当期UP角色，也就是"大保底"。实现方式并不复杂：每次出SSR后清零计数，如果累计未出SSR达到89，那么第90抽单独判断必出SSR。这里的"第几抽"需要精确控制，否则会出现99抽才出SSR的bug。
3.2 为什么不能只靠全局变量
第二期我们在模块顶部写了一个Public drawCount As Long，点击一次抽卡就加一。这种变量只要关掉Excel就会失去记忆，重新打开又从0开始。对初学者来说，最容易踩的坑就是"我在调试的时候明明到70抽了，为什么关掉再打开变回0"。
解决方案有两个：一是用工作表的隐藏单元格存储，二是用Excel自带的自定义属性（CustomDocumentProperties）。我推荐前者，因为隐藏单元格直观、可调试、也能顺便在界面上显示。自定义属性虽然更整洁，但很多新手容易忘记读取位置，反而增加复杂度。
3.3 隐藏工作表当数据库
新建一张名为状态的工作表，把工作表的Visible属性设为xlSheetHidden，让它别被用户轻易看到。A1放累计抽数，B1放当前保底计数，C1放累计SSR数，D1放上次出货时间等等。
读取和写入可以封装成函数，避免所有代码都直接引用单元格地址：
Function GetPityCount() As Long GetPityCount = ThisWorkbook.Sheets("状态").Range("B1").Value End Function Sub SetPityCount(ByVal newCount As Long) ThisWorkbook.Sheets("状态").Range("B1").Value = newCount End Sub在抽取函数内部，每次出货前更新保底计数：
Dim pityCount As Long pityCount = GetPityCount() If rarity = "SSR" Then SetPityCount 0 Else SetPityCount pityCount + 1 If pityCount + 1 >= 89 Then ' 下一次必出SSR，在调用抽取函数前强制指定稀有度 End If End If这里需要特别注意：保底计数和"本次结果是否SSR"的判断顺序不能颠倒。如果先判断结果再更新保底，那第90抽可能还是按正常概率出R，导致保底失效。正确的做法是先读取当前保底计数，如果等于89就强制本次为SSR，否则走正常随机。
3.4 统计面板的刷新逻辑
有了状态表，统计面板就可以实时刷新。我习惯在按钮点击宏最后调用一个RefreshStats过程，把累计抽数、距离保底还剩几抽、各稀有度数量全部重算并写入统计区域。
Sub RefreshStats() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("统计") Dim stateWs As Worksheet Set stateWs = ThisWorkbook.Sheets("状态") ws.Range("B2").Value = stateWs.Range("A1").Value ws.Range("B3").Value = stateWs.Range("B1").Value ws.Range("B4").Value = 89 - stateWs.Range("B1").Value End Sub用代码刷新而不是用公式，好处是逻辑集中在VBA里，不会因为公式引用位置变动而崩。缺点是你得记得每次抽卡后都调用它。我个人的习惯是单抽和十连各自调用，但都在同一批按钮事件里执行，尽量减少漏刷。
4. 历史记录、导出与清理：让模拟器有"数据后台"
4.1 记录表结构设计
历史记录是整个模拟器的"数据库"，重要性不亚于抽取逻辑。我在工作簿里放一张名为抽卡日志的表，列结构如下：
| 时间 | 抽卡方式 | 稀有度 | 卡名 | 是否保底 | 累计抽数 |
|---|---|---|---|---|---|
| 2025-... | 单抽 | SSR | 伊芙 | 否 | 74 |
| 2025-... | 十连 | SR | 雷恩 | 是 | 84 |
其中"是否保底"字段帮你复盘每张SSR到底是正常出货还是保底出的；"累计抽数"记录的是出货那一刻的总抽数，便于计算平均出货间隔。这张表可以暂时不用格式化，后续再写一个一键美化宏。
4.2 用数组一次写入，别让VBA逐格写
很多新手在写日志时习惯在循环里Cells(i,1).Value = xxx，抽个几十次还不觉得慢，一旦跑一万次测试，Excel能卡到让你怀疑人生。原因是VBA和Excel表格之间的交互极其昂贵，逐格写入等于每写一格都做一次跨进程通信。
正确做法是先把要写入的数据存进VBA数组，最后一次性写入Range。下面以十连为例：
Sub LogDrawBatch(ByVal count As Long, ByRef results() As String, ByRef rarities() As String) Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("抽卡日志") Dim startRow As Long startRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 Dim dataArr() As Variant ReDim dataArr(1 To count, 1 To 6) Dim i As Long Dim nowTime As String nowTime = Format(Now, "yyyy-mm-dd hh:mm:ss") For i = 1 To count dataArr(i, 1) = nowTime dataArr(i, 2) = IIf(count = 1, "单抽", "十连") dataArr(i, 3) = rarities(i) dataArr(i, 4) = results(i) dataArr(i, 5) = IIf(rarities(i) = "SSR", "否", "保底判断") ' 这里按实际逻辑填 dataArr(i, 6) = GetPityCount() Next i ws.Range(ws.Cells(startRow, 1), ws.Cells(startRow + count - 1, 6)).Value = dataArr End SubdataArr虽然声明成Variant，但写入时每格的数据类型是明确的。一次性赋值给Range对象时，Excel会自动按二维数组的行列映射到单元格区域。这个技巧是VBA性能优化的第一课，强烈建议背下来。
4.3 导出成CSV和备份
历史记录放在Excel里，如果工作簿崩溃，你的抽卡数据可能全没。所以我会定期导出成CSV文件。用最简单的导出方式：
Sub ExportLog() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("抽卡日志") Dim savePath As String savePath = ThisWorkbook.Path & "\抽卡日志_" & Format(Now, "yyyymmdd_hhmmss") & ".csv" ws.Copy ActiveWorkbook.SaveAs fileName:=savePath, FileFormat:=xlCSV ActiveWorkbook.Close False End Sub代码原理是复制日志表到一个新工作簿，然后用SaveAs保存成CSV。这里要注意：ThisWorkbook.Path如果你是第一次运行且文件还没保存过，可能是空字符串。所以建议先把你这个模拟器工作簿另存为一个固定路径下的.xlsm文件，再跑导出。
4.4 数据清理与重置
随着测试次数增加，日志表会有几万行甚至更多。Excel处理几万行其实压力不大，但每次打开文件、翻看表格都会变慢。我的处理方式是设置一个上限，比如超过10000行时提示是否清理旧数据。
Sub CleanOldLogs() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("抽卡日志") Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row If lastRow > 10000 Then Dim deleteTo As Long deleteTo = lastRow - 5000 ws.Rows("2:" & deleteTo).Delete MsgBox "已清理旧记录，保留最近5000条。" End If End Sub清理动作会连带影响累计抽数，所以真正的"重置"应该是把状态表所有字段归零、日志表清空、统计区恢复初始值三件事一起做，单独清理日志很容易造成保底计数和实际抽数对不上。
5. 界面、防呆与性能细节：最后20%的完成度
5.1 按钮事件与连点保护
功能都齐了，但如果用户快速连点十次按钮，VBA可能同时触发多次抽取，把保底计数搞乱。我的解决方案很朴素：用一个模块级标志位加上DoEvents检查。
Dim isDrawing As Boolean Sub DrawButton_Click() If isDrawing Then MsgBox "正在抽卡，请稍候" Exit Sub End If isDrawing = True Application.EnableCancelKey = xlDisabled ' 这里放主要抽卡逻辑 Call DoSingleDraw isDrawing = False Application.EnableCancelKey = xlInterrupt End Sub在进入抽卡逻辑前先把isDrawing设成True，结束再还原。这样即使按钮被快速连点，第二次点击也会因为isDrawing = True而被拦住。Application.EnableCancelKey = xlDisabled是为了防止用户在抽卡循环中按Esc把宏打断，导致isDrawing永远卡在True。这个保护我建议只放在循环测试里，平时单抽不用加。
5.2 长跑测试先关屏幕刷新
如果你要跑一万次抽取，绝对不要在每次循环里都写入工作表，也不要开着屏幕刷新。一个典型的性能优化模板是：
Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' 执行大量操作 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = TrueScreenUpdating = False能屏蔽Excel界面刷新，让宏跑得更快；Calculation = xlCalculationManual则是在你操作期间不让Excel自动重算公式，等全部完成后一次性计算。但注意，如果你在主界面使用了RAND()之类的易失函数，手动计算模式下这些函数不会自动更新，你得在最后手动调用Application.Calculate。
5.3 错误处理：Resume Next要慎用
VBA新手最喜欢写On Error Resume Next，一句话屏蔽所有错误，程序不弹窗了，但异常也被吞掉了。这样做最危险的情况是：某个单元格写入失败，后面所有数据全部错位，你却完全不知道。我的建议是只在极少数确定不会出错的地方用Resume Next，其余地方要么不处理，要么用On Error GoTo ErrorHandler。
Sub SafeDraw() On Error GoTo ErrorHandler Call DoSingleDraw Exit Sub ErrorHandler: MsgBox "抽卡出错：" & Err.Description End Sub这样至少能知道哪里炸了。配合Debug.Print Err.Source，能把错误定位到具体过程。如果你发现代码明明没报错，数据却不对，就去检查一下是不是On Error Resume Next把关键赋值给忽略了。
5.4 这个模拟器还能怎么扩展
完成到这一步，你的模拟器已经是一个可以日常使用的工具了。如果想继续迭代，我建议从这三个方向选一个：
- 增加"抽卡统计直方图"：把每次出货所间隔的抽数记录下来，用图表显示分布，最适合验证保底机制是否合理。
- 做成多页签的"卡池管理器"：每个页签对应一个活动卡池，抽卡时自动读取当前卡池配置。
- 把抽卡记录与更重的外部统计工具联动：导出CSV后，用Python做更复杂的分析，VBA负责前端交互即可。
但我不建议一上来就搞太复杂。先把现在这个版本用一周，每日抽几十次，观察统计面板有没有异常，再去加新功能。
最后分享一点我个人的体会：抽卡模拟器的核心不在"抽"这个动作，而在于你如何理解概率和工程化。当你把一套需求拆成概率表、状态存储、日志写入、界面交互四个模块后，你会发现自己以后再写VBA工具，天然会带着"数据怎么流转"的视角。这种能力比任何一个具体函数都值钱。如果你也正在学VBA，不妨拿这个抽卡模拟器作为长期练手项目，隔一段时间重构一次，我保证每次都会有新收获。
