公司年会中，如果有一个抽奖环节，那就是需要有一个随机过程来进行抽奖活动。

本节将介绍一个小方法，通过一个VBA代码来实现整个抽取过程。

实现方法

既然是抽奖，那么就涉及到一个随机过程，也就是说不一定抽到谁，但要有一个抽取名单，也就是一个随机池。

我们把这个随机池设定为一个工作表单元格内容，或者是一个数组，本节示例中以数组来进行随机抽取。

过程界面如下图所示：

三个按钮，一个开始、一个停止和一个重置复位。

每个按钮有不同的过程。

随机过程中会对已经抽取出来的名字进行一个筛选处理年会抽奖系统，也就是说下次抽取就不会再把已经抽取的人再次抽取出来。

实现方法是将已经抽取的人放置到一个数组里，下次抽取通过遍历这个数组就可以确定是否已经抽取出来，如果存在就不进行抽取。

代码

全局变量定义

Option Explicit
Dim xArr()'定名义单数组
Dim isID As Integer
Dim isIDarr(), iid As Integer'定义筛选名单数组
Dim isTrue As Boolean'定义退出循环变量

开始按钮代码

Private Sub 开始抽取()
On Error Resume Next
Me.CommandButton1.Enabled = False
isTrue = False
Dim xCaption As String
Dim xR As Range, r As Range, ir As Long
ir = ThisWorkbook.Worksheets(2).Range("A65535").End(xlUp).Row
If ir <= 1 Or ir > 65535 Then Exit Sub
Set xR = ThisWorkbook.Worksheets(2).Range("A2:A" & ir)
If xR.Count <> 1 Then
    xArr = Application.WorksheetFunction.Transpose(xR)
Else
    ReDim xArr(0, 0)
    xArr(0, 0) = xR.Value
End If
Dim idTrue As Boolean
Do'循环抽取
    idTrue = False
    isID = VBA.Int((UBound(xArr, 1) - 1 + 1) * Rnd + 1)
    For iid = LBound(isIDarr) To UBound(isIDarr)
        If isIDarr(iid) = isID Then
            idTrue = True
        Exit For
        End If
    Next iid
    If Not idTrue Then
        xCaption = xArr(isID)
        Me.Shapes(1).TextFrame.Characters.Text = xCaption'显示名单
    End If
    DoEvents
Loop Until isTrue
ir = ThisWorkbook.Worksheets(2).Range("C65535").End(xlUp).Row + 1
ThisWorkbook.Worksheets(2).Range("C" & ir).Value = xCaption
Set xR = Nothing
Set r = Nothing
Erase xArr
End Sub

停止按钮代码

Private Sub 停止()
On Error Resume Next
isTrue = True'退出循环
If UBound(xArr) = UBound(isIDarr) Then
    MsgBox "没有可选人了!", vbInformation, "提示"
    Exit Sub
End If
Me.CommandButton1.Enabled = True
ReDim Preserve isIDarr(UBound(isIDarr) + 1)
isIDarr(UBound(isIDarr)) = isID
End Sub

重置按钮代码

Private Sub 重置()
Dim ir As Integer
Me.CommandButton1.Enabled = True
ir = ThisWorkbook.Worksheets(2).Range("C65535").End(xlUp).Row + 1
ThisWorkbook.Worksheets(2).Range("C2:C" & ir).Value = ""
Erase isIDarr
ReDim isIDarr(0)
End Sub

工作表

工作表就简单了年会抽奖系统，三个字段，第一列为所有抽取人姓名，第二列设置奖项，第三列是自动添加抽取出来的名单。

这样就完成了一个抽奖过程程序制作，应用起来很简单。