界面

抽獎界面

使用說明

點擊”開始“，啟動抽獎，停止顯示本次中獎人.
清除按鈕，排除中獎人。

代碼

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