简介：一份面向企事业单位年会、春节联欢等场景的Excel VBA抽奖程序，由Excel工作表与宏代码实现，适合需要快速搭建现场抽奖环节的行政、HR或活动组织者使用。程序内置特等奖至五等奖及自定义奖项，支持按奖项级别批量抽取、现场弃权、中奖者照片与部门信息展示，抽奖结果自动归档到工作表，背景、音乐、界面布局均可按活动主题调整。压缩包共27个文件，以xls程序文件、jpg照片素材、wav音效为主，另含htm说明页与辅助dll，整体仅1.35MB，小巧易部署。已有1443人学习下载。资源附带两套Excel模板以及photo、Music素材目录，覆盖从候选名单录入、奖项设置到结果留痕的完整流程；说明文档对宏安全级别、死循环规避、照片命名规范等关键事项做了提示，能帮助使用者在春节抽奖活动中快速上手并规避常见问题。 每年春节前，行政和HR最头疼的事之一，就是年会抽奖。用第三方抽奖软件怕有广告、怕不公平，买实体抽奖箱又缺乏现场气氛。我自己被这个问题折磨了两年后，干脆用Excel写了一个抽奖程序，配合大屏幕投影，既能实现名单滚动效果，又能保证等概率、不重复抽取，操作起来还特别简单。应同事要求分享过很多次，这次整理成一篇完整的实操文章，从方案选型到VBA代码、到避坑指南一次讲清楚。想自己动手给部门或公司年会做个抽奖工具的朋友，照着做就行。
1. 项目规划与方案选型：同样叫“抽奖”，差距在哪
1.1 三种主流实现方案对比
我在动手之前，把市面上能用的方案都捋了一遍。Excel纯公式方案、VBA宏方案、第三方在线抽奖工具，各有利弊。
纯公式方案很简单，利用RAND()函数生成随机数，再搭配INDEX和MATCH从名单里取名字，按F9刷新就能换人。这个方案的好处是零门槛、不需要开启宏，但坏处也明显：现场大屏幕上看不到名字滚动的效果，每次刷新都是直接跳一个名字，气氛差很多。另外，RAND()是易失性函数，表格里任何单元格操作都会导致结果变化，抽完想定格结果还得复制粘贴成值，操作别扭。
第三方在线抽奖工具看着方便，但要考虑数据隐私问题——全公司员工名单传到别人的服务器上，总觉得不太踏实。而且免费版通常有抽奖人数限制，界面里还挂着广告，年会现场万一弹窗，画面非常尴尬。
VBA方案综合下来最稳妥：名单留在本地Excel里，不上传、不联网；代码能实现名单快速滚动的动画效果；随机逻辑完全可控，可以设计成不重复抽取；中奖名单还能自动记录到工作表里。唯一的门槛是需开启宏，这个你拿到员工电脑上运行前把宏安全性调好就行了，后面我会详细说。
1.2 为什么我推荐“VBA + 滚动动画”组合
年会抽奖和平时办公室里随机选个人完全不是一回事。现场几十双眼睛盯着大屏幕，大家要的不是一个冷冰冰的结果，而是一个“有仪式感”的过程。名单快速滚动，主持人说停，名字定格，底下一片欢呼——这才是年会抽奖该有的样子。
我把核心体验点拆成了三个：滚动动画要有节奏感、结果要绝对随机、中奖人不能重复。这三个需求用纯公式方案很难同时满足，但VBA配合Application.OnTime定时器就能轻松做到。滚动时每隔一小段时间换一个名字，视觉上就是快速闪动，停止时再把最终结果写到醒目的单元格里。
另外还有一个容易被忽略的细节：抽奖的“公平感”。用人的肉眼去看滚动条，没人能判断什么时候停是“故意的”，所以滚动速度不能太慢，我建议控制在每秒20次左右的刷新频率，既流畅又有悬念。
1.3 抽奖逻辑设计：等概率、不重复、可追溯
写代码之前，先把抽奖逻辑想清楚。我用的是“洗牌取前N个”的思路，也就是把名单看成一副牌，先随机打乱顺序，再从最前面依次拿人。这个方案的好处是：
- 等概率：每个人被打乱到任意位置的概率是均等的，不存在“每次重新抽”带来的权重偏差；
- 不重复：抽完一个人就从牌堆里拿走，天然不会重复；
- 可追溯：洗牌后的顺序、每次抽奖结果都能输出到工作表，事后任何人有疑问，都能查到记录。
如果用“每次从全名单里随机取一个，取到重复就重新取”的方案，会出现一个概率陷阱：当名单人数很多时还好，抽到最后几个人时，重复概率会急剧上升，程序可能要循环很多次才能抽到新人，非常低效。洗牌算法的效率是 O(n)，比反复随机取数稳定得多。
2. 搭建抽奖表：界面布局与名单管理
2.1 工作表结构与初始配置
打开Excel后，先把工作表的“骨架”搭好。我习惯把这个工作簿做成三个表，按Ctrl+F11插入模块时会更清晰：
| 工作表名 | 用途 |
|---|---|
| 名单 | 存放所有参与抽奖的人，A列放姓名或工号 |
| 抽奖台 | 主展示界面，大屏幕投影时切到这个表 |
| 中奖记录 | 自动记录每一轮抽奖的结果，留档备查 |
抽奖台表是关键，布局我建议这样安排：B2单元格放一个超大字号（推荐72号以上）的姓名显示区，作为滚动定格的主角；旁边F2单元格放“本轮抽奖人数”，比如一等奖抽3人，就填3；下方预留一块区域，专门显示本轮抽出的所有人；再放两个按钮，一个“开始滚动”，一个“停止抽奖”。
这个布局有个讲究：显示区要够大、够居中，投影效果才震撼。辅助信息放到边角，避免干扰大屏幕画面。
2.2 名单准备的三个细节
名单准备看起来简单，实际坑不少，我吃过亏。分享三点：
第一，必须去重。年会抽奖名单往往是行政从人事系统里导出的，同一个员工可能因为部门信息不同出现两次。如果不先去重，这个人的中奖概率就是别人的两倍。处理方式很简单：选中名单列，数据选项卡里点“删除重复值”。
第二，注意隐藏Sheet和无效数据。名单表里如果有隐藏行、筛选未清除的残留，用End(xlUp)统计行数时很容易漏算。我建议名单区域从A2开始放，A1写表头，这样代码读取时以A列最后一个非空单元格为准。
第三，显示字段要规范。如果公司人多、有重名现象，名单里建议用“部门-姓名”这种格式，比如“市场部-张三”，避免抽到重名后说不清是谁。注意中间那个“-”要用同样的符号，避免格式混乱。
2.3 用“定义名称”锁定数据源范围
很多人写代码时会固定写死“A2:A100”这种范围，但年会名单每年人数都不一样，写死了后续维护麻烦。我建议用“定义名称”功能，给名单区域起一个名字，比如就叫“员工名单”。
操作步骤：公式选项卡 -> 名称管理器 -> 新建，名称填“员工名单”，引用位置填：
=名单!$A$2:$A$1000范围可以稍微放大一点，反正后面代码会动态判断实际有效人数。这样就算名单从100人变成200人，代码不用改，数据源也能自动覆盖。
3. 核心代码实现：滚动抽奖与批量抽奖
3.1 滚动抽奖：实现“滚起来再停稳”
核心代码我拆成两部分：一个是“开始滚动”的宏，另一个是“停止滚动”的宏。滚动原理是每隔一小段时间就用VBA从名单里随机取一个名字填到B2单元格，速度快了，视觉上就是名单在滚动。
在VBA编辑器中按Alt+F11打开编辑器，插入模块，粘贴以下代码：
Public blnRolling As Boolean Sub StartRoll() ' 停止之前可能残留的滚动任务 If blnRolling Then blnRolling = False Application.OnTime EarliestTime:=dNextRun, Procedure:="RollName", Schedule:=False End If Dim lngCount As Long Dim wsAshow As Worksheet Set wsAshow = ThisWorkbook.Sheets("抽奖台") lngCount = Application.WorksheetFunction.CountA(Range("员工名单")) If lngCount = 0 Then MsgBox "名单为空，请先到名单表填写数据！", vbExclamation Exit Sub End If blnRolling = True wsAshow.Range("B2").Value = "开始滚动..." Call RollName End Sub Sub RollName() If Not blnRolling Then Exit Sub Dim lngIndex As Long Dim lngCount As Long Dim wsAshow As Worksheet Set wsAshow = ThisWorkbook.Sheets("抽奖台") lngCount = Application.WorksheetFunction.CountA(Range("员工名单")) If lngCount = 0 Then Exit Sub Randomize lngIndex = Application.WorksheetFunction.RandBetween(1, lngCount) wsAshow.Range("B2").Value = Range("员工名单").Cells(lngIndex, 1).Value ' 每隔0.05秒刷新一次，制造滚动效果 dNextRun = Now + TimeValue("00:00:00.05") Application.OnTime EarliestTime:=dNextRun, Procedure:="RollName" End Sub Sub StopRoll() If blnRolling Then blnRolling = False Application.OnTime EarliestTime:=dNextRun, Procedure:="RollName", Schedule:=False End If End Sub注意几个关键点：
blnRolling是模块级变量，用来标记当前是否在滚动中，防止重复点击“开始”按钮导致多个定时器叠加。dNextRun也需要在模块顶部声明为Public dNextRun As Date，这样停止时才能精确取消定时任务。
Application.OnTime的作用是“预约”一个时间点执行某个过程，这里预约0.05秒后再执行一次RollName，每次执行完再预约下一次，形成循环。为什么不用Do Loop死循环？因为死循环会独占CPU，年会现场如果同事还在用这台电脑操作其他东西，会卡到怀疑人生。OnTime是异步的，滚动过程中界面还能正常响应。
Randomize放在循环里其实不是必需的，但加上无害，可以防止某些极端情况下随机数序列不够“散”。这里我用的是RandBetween，它会返回1到总人数之间的整数，简单直观。
3.2 批量抽奖：一次性抽出多个人
实战里还有另一种常见需求：不是抽一个人，而是“三等奖抽10人”这种一次抽一批。这时我单独写了一个“批量抽奖”宏，用洗牌算法实现：
Sub BatchDraw() Dim wsAshow As Worksheet Dim lngCount As Long Dim arrData() As String Dim i As Long, j As Long Dim strTmp As String Dim lngDraw As Long Dim rngOutput As Range Set wsAshow = ThisWorkbook.Sheets("抽奖台") lngCount = Application.WorksheetFunction.CountA(Range("员工名单")) If lngCount = 0 Then MsgBox "名单为空！", vbExclamation Exit Sub End If lngDraw = wsAshow.Range("F2").Value If lngDraw <= 0 Or lngDraw > lngCount Then MsgBox "抽奖人数不合法，请检查F2单元格！", vbCritical Exit Sub End If ' 把名单读入数组 ReDim arrData(1 To lngCount) For i = 1 To lngCount arrData(i) = Range("员工名单").Cells(i, 1).Value Next i ' Fisher-Yates洗牌算法 Randomize For i = lngCount To 2 Step -1 j = Int(i * Rnd) + 1 strTmp = arrData(i) arrData(i) = arrData(j) arrData(j) = strTmp Next i ' 输出前lngDraw个名字 Set rngOutput = wsAshow.Range("H2") rngOutput.Resize(lngDraw, 1).Value = Application.Transpose(Array()) For i = 1 To lngDraw rngOutput.Cells(i, 1).Value = arrData(i) Next i ' 把本轮中奖名单保存到中奖记录表（追加写入） Dim wsLog As Worksheet Set wsLog = ThisWorkbook.Sheets("中奖记录") Dim lngNextRow As Long lngNextRow = wsLog.Cells(Rows.Count, 1).End(xlUp).Row + 1 For i = 1 To lngDraw wsLog.Cells(lngNextRow + i - 1, 1).Value = arrData(i) wsLog.Cells(lngNextRow + i - 1, 2).Value = Now Next i MsgBox "本轮抽奖完成，共抽取 " & lngDraw & " 人，结果已记录！", vbInformation End Sub这段代码里的洗牌算法值得单独解释一下。For i = lngCount To 2 Step -1是倒序遍历，每次循环时把当前元素和它之前的任意一个随机位置交换。一轮下来，整个数组的顺序就被完全打乱，而且数学上可以证明，每个元素出现在任意位置的概率都是相等的。之后直接从打乱后的数组头部取人，就实现了不重复、等概率的批量抽取。
输出到H2单元格后，同时把中奖名单和当前时间追加写入“中奖记录”表，这样年会结束后统计中奖人员、发奖品时就有据可查。
3.3 按钮与宏绑定、安全设置
代码写完后，回到“抽奖台”表插入两个形状当做按钮。右键点击形状 -> 指定宏 -> 分别绑定StartRoll和StopRoll，批量抽奖那个按钮就绑定BatchDraw。
宏安全设置这里必须强调：如果直接在没做任何设置的情况下双击打开工作簿，Excel默认禁用所有宏，按钮点了没有任何反应。正确的做法是进入 文件 -> 选项 -> 信任中心 -> 信任中心设置 -> 宏设置，选择“禁用所有宏，并发出通知”或“启用所有宏”。年会现场用的电脑建议直接“启用所有宏”，省得到时候弹提示影响操作。
还有一点，年会结束后这份文件可能会发给其他同事。如果里面有VBA代码，发送.xlsx格式会把宏丢掉，因为xlsx格式默认不支持宏。保存文件时必须选“Excel启用宏的工作簿(*.xlsm)”格式，否则代码全白写。
4. 实战演练与常见问题排查
4.1 正式使用前必须做的3件事
第一，用全量数据跑一遍。不要拿两三个测试名字就算验证过了，把真实名单放进去，连续抽几十轮，确认名字不会卡在同一个、不会出现空白、停止按钮能正常定格。
第二，检查显示字号和投影比例。B2单元格的字号建议在72以上，如果字体太细，投影出来后远处看不清。字体最好用“微软雅黑”或“思源黑体”这类粗笔画字体，避免“宋体”在远距离看发虚。
第三，把中奖记录表提前清空。年会前测试产生的记录会留在“中奖记录”表里，正式开始时先全选删除，保证统计无误。
4.2 高频问题速查表
| 现象 | 原因 | 解决办法 |
|---|---|---|
| 点按钮没反应 | 宏被禁用 | 检查信任中心宏设置，重新打开工作簿 |
| 名单会重复出现 | 名单表里有重复值 | 对名单列做“删除重复值” |
| 滚动速度太慢 | OnTime间隔太长 | 把TimeValue("00:00:00.05")改小，如"00:00:00.03" |
| 停止后B2没名字 | 滚动还没开始就点了停止 | 在StartRoll里先判断状态，停止时显示当前值 |
| 保存后宏丢失 | 存成了xlsx格式 | 另存为 xlsm 格式 |
| 大批量抽取时卡顿 | 名单数组红用了Variant反复操作 | 改用String数组，减少单元格读写 |
| 第二次点开始报错 | Timer没有取消 | 用模块级变量记录dNextRun并Schedule:=False |
这里我想特别说说“滚动速度”这个参数。0.05秒刷新一次，视觉上是肉眼能感知到快速跳动的效果。如果改成0.03秒，看起来就像“糊”成一团，其实更有悬念感，但对电脑性能要求高一些。年会现场如果用老旧的投影电脑，0.05秒更稳妥。
4.3 进阶扩展：多轮抽奖、界面美化、防误操作
基础功能跑通后，还可以加一些细节让它更像个“产品”。
多轮抽奖需要保证“同一人不能重复中奖”，这时可以在名单表里加一个“已中奖”标记列。每次抽完，用代码把中奖人对应行的标记列设为“是”，后续抽奖时先过滤掉“已中奖”的人。这个逻辑不复杂，核心就是动态构建一个“有效名单”数组。
界面美化方面，春节场景可以把B2单元格填充成红色背景、白色字体，或者用条件格式让名字在定格时闪烁两次。Excel自带的“页面布局 -> 背景”功能还能给工作表加上一张年会主视觉图，投影氛围会好很多。
防误操作这件事容易被忽略。年会现场人多手杂，鼠标可能被乱点。我建议在抽奖台表里把除B2和F2之外的所有单元格锁定，然后保护工作表，只保留“停止抽奖”按钮的功能。具体操作：选中整个工作表 -> 设置单元格格式 -> 保护 -> 取消锁定，再选中B2、F2设为锁定，最后 审阅 -> 保护工作表。
5. 最后再分享几个实战细节
我在实际做这个抽奖程序时，踩过几次坑之后总结出几条经验，算是不成文的补充。
第一，名单里尽量不要用“张三、李四”这种临时测试数据来做年会正式版。有一次我拿测试名字检查流程，结果忘记覆盖，现场抽出来全是“测试1、测试2”，场面极其尴尬。正式使用前，一定要把名单表彻底清空再粘贴真实数据。
第二，VBA工程别忘了加密码保护。文件发给其他同事后，难免有好奇的人用Alt+F11想看代码甚至改代码。在VBA编辑器里右键工程 -> VBAProject属性 -> 保护 -> 勾选“查看时锁定工程”，输入两次密码，宏代码就只可运行、不可被随意修改了。这个不是必须的，但如果这台电脑不是你自己掌控，建议加上。
第三，有条件的话，准备一台备用电脑。往年年会我最担心的不是代码出错，而是现场电脑突然蓝屏、投影线松了。把.xlsm文件同时拷到两台电脑上，一台出问题，另一台马上顶上，输赢就在一分钟之内。
这个程序后来我每年春节前都会翻出来改一改，偶尔还会有人过来问“能不能帮我做一个”。希望这篇整理对你也有用，至少下次年会前，你不需要再为抽奖环节发愁了。
本文还有配套的精品资源，点击获取
