求大神指导，抽奖功能

以下是事件触发VBA程序，点击工作表标签，按Alt-F11，将底下的代码填入右边的代码窗。
然后按图填入 A1：A100 奖品, 及B1，C1 （功能是抽奖按钮）。
设置完成就可开玩了，双击 B1 , 或 C1开始抽奖。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Cancel = True
If Intersect(Target, Range("B1:C1")) Is Nothing Then Exit Sub
Dim RS(1 To 3) As Integer
Dim TC As Integer: TC = Target.Column
Man = Array(Array("张三", 10), Array("李四", 20))
Dim STR As String
For i = 1 To 3
RS(i) = Cells(9999, i).End(xlUp).Row
Next
If RS(1) = 1 And Range("A1") = "" Then MsgBox "没有奖品": Exit Sub
If RS(TC) > Man(TC - 2)(1) Then MsgBox Man(TC - 2)(0) & "抽奖配额用完": Exit Sub
Cells(WorksheetFunction.RandBetween(1, RS(1)), 1).Select
STR = Selection.Value
MsgBox "你抽到 : " & STR
Selection.Delete Shift:=xlUp
Cells(RS(TC) + 1, TC).Select
Selection = STR
End Sub