Excel VBA 编写简单的抽奖小程序

大家好，我是捌贰春秋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