excel抽奖小工具

界面

使用说明

点击”开始“，启动抽奖，停止显示本次中奖人.
清除按钮，排除中奖人。

代码

Dim flag
Sub 开始()
c = Rnd
Dim rng As Range
Set dic = CreateObject("scripting.dictionary")
n = 0
For i = 2 To 201
If Application.WorksheetFunction.CountIf(Range("J3:L12"), _
Worksheets("人员名单列表").Cells(i, 1)) = 0 Then
n = n + 1
dic(n) = Worksheets("人员名单列表").Cells(i, 1)
End If
Next
flag = True
Do
DoEvents
If flag Then
Cells(4, 2) = dic(Int(Rnd * dic.Count + 1))
End If
Loop While flag
End Sub
Sub 停止()
flag = False
For i = 3 To 10
For j = 4 To 10
If Cells(i, j) = "" Then
Cells(i, j) = Cells(3, 4): GoTo 100
End If
Next
Next
100:
End Sub
Sub 清除()
For i = 2 To 100
c = Rnd
Next
Range("J3:L12").ClearContents
End Sub