最近有粉丝在后台向我提了一个工作中的小需求，具体如下：
■因为公司要组织一个知识竞赛，其中有一个游戏环节，需要从一组名单中随机选出指定数量的人员参加游戏，并且需要在大屏中滚动名单以增强游戏紧张感。当然最重要的是最终被选中的名单中不能有重复名单出现。她希望能通过Excel来实现这个需求。
需求分析：其实这个需求与抽奖非常类似，我们可以通过Excel的VBA宏功能来编写一个小工具来实现这个需求，说干就干，以下就是最终实现的成品效果：
抽奖小工具演示
功能说明：
第1步、名单在sheet2《名单维护》工作表的A列中输入
第2步、设置抽奖人数
第3步、点击开始按钮，名单开始滚动
第4步、点击停止按钮，出现获奖人员名单
制作步骤如下：
第一步：制作表格
- 建立两个工作表，分别为《抽奖页面》和《名单维护》页面。将待抽奖名单放在《名单维护》页的A列，其中A1单元格为标题
第二步：编写代码
- 点击开发工具-VisualBasic,或按下快捷键ALTF11启动VisualBasicforApplications窗口
- 在“插入”菜单上，单击“模块”
- 在出现的模块1代码窗口中，复制并粘贴以下代码：
#IfVBA7Then
PrivateDeclarePtrSafeSubSleepLib"kernel32"(ByValmsAsLongPtr)
#Else
PrivateDeclareSubSleepLib"kernel32"(ByValmsAsLong)
#EndIf
DimmarkAsBoolean
Sub立即开始()
mark=True
DoWhilemark
DoEvents
Sleep100
抽奖
Loop
EndSub
Sub停止抽奖()
mark=False
EndSub
Sub抽奖()
DimM&,N&,i&,j&,arr
DimdAsObject
Setd=CreateObject("scripting.dictionary")
arr=Sheet2.Range("A2:A"&Sheet2.Range("A65536").End(xlUp).Row)
Range("B4:B65536").ClearContents
M=Range("D4")
N=UBound(arr)
IfN<MThenMsgBox"人数超出"&N:ExitSub
DoWhilei<M
j=Int(Rnd()*N1)
IfNotd.exists(j)Then
i=i1
d(j)=arr(j,1)
EndIf
Loop
Range("B4").Resize(d.Count,1)=Application.Transpose(d.items)
EndSub
写入代码
第三步：插入命令按钮
- 通过开发工具——插入——Active控件，插入一个命令按钮
- 双击这个命令按钮，输入过程名“立即开始”，并将这个按钮的caption属性改为“开始”
- 重复以上步骤再插入一个命令按键，输入过程名“停止抽奖”，并将这个按钮的caption属性改为“停止”
插入命令按钮
第四步：名单演示美化
- 利用条件格式设置名单的填充色和字体颜色
- 利用公式确定要设置格式的单元格：=B1<>""
设置格式，利用了字典数组实现了名单的随机不重复抽取。