大家好，我是捌贰春秋VBA，今天运用字典跟窗体控件的相关知识，带大家编写一个简单的抽奖小程序。
窗体控件功能介绍
1、切换按钮ToggleButton1：开始抽奖、暂停抽奖，默认Value值为False即按起状态。
2、姓名显示区Label1：用于显示抽中人员的姓名。
3、中奖名单ListBox1：罗列抽中人员的名单，并进行编号。
4、初始化按钮CommandButton2：恢复抽奖名单，清空中奖人员列表。
工作表准备
1、工作表1人员名单：参与抽奖人员，每次抽中的人员从人员名单中删除。
2、工作表2备份：用于初始化系统，即恢复参与抽奖的人员名单。
代码
1、模块中自定义公共变量，编写整理抽奖名单的Sub
Public n%, d As Object
Sub 整理抽奖名单()
Dim arr, i%
Set d = CreateObject("scripting.dictionary")
arr = Sheets("人员名单").Range("A1").CurrentRegion
For i = 2 To UBound(arr)
arr(i, 1) = i - 1
Next i
Sheets("人员名单").Range("A1").CurrentRegion = arr
'序号为关键字，姓名为条目构建字典
For i = 2 To UBound(arr)
d(arr(i, 1)) = arr(i, 2)
Next i
'获取序号的最大值
n = UBound(arr) - 1
End Sub
2、开始抽奖、暂停抽奖
Private Sub ToggleButton1_Click()
On Error Resume Next
Dim K, rng As Range
Call 整理抽奖名单
If Me.ToggleButton1.Value = True Then
Me.ToggleButton1.Caption = "暂停抽奖"
Do
'随机1至n之间的数字给到变量K，用字典d(K)带出人员姓名
K = WorksheetFunction.RandBetween(1, n)
Me.Label1.Caption = d(K)
DoEvents
Loop Until Me.ToggleButton1.Value = False
Else
Me.ToggleButton1.Caption = "开始抽奖"
Me.ListBox1.AddItem Me.ListBox1.ListCount + 1 & ". " & Me.Label1.Caption
'从人员名单删除掉已抽中的人员
Set rng = Sheets("人员名单").Range("B:B").Find(Me.Label1.Caption, , , 1)
rng.EntireRow.Delete
'移除字典所有的关键字
d.RemoveAll
Call 整理抽奖名单
End If
End Sub
3、初始化系统
Private Sub CommandButton2_Click()
If MsgBox("是否初始化系统？抽奖记录将被清除，不可恢复！", vbYesNo) = vbNo Then Exit Sub
Me.ListBox1.Clear
Me.Label1.Caption = "显示区"
Sheets("备份").UsedRange.Copy Sheets("人员名单").Range("A1")
End Sub