|
本帖最后由 彭希仁 于 2012-2-6 09:53 编辑
Public x, d
Private Sub CommandButton1_Click()
x = 0
TextBox1.Text = ""
arr = Sheets("抽奖名单").Range("A1:C" & Sheets("抽奖名单").[A65536].End(xlUp).Row)
arr2 = arr
y = UBound(arr)
Do
For i = 3 To y
If Not d.Exists(i) Or d.Count > y - 2 Then
Label6.Caption = Me.ComboBox1.Text & ":" & arr2(i, 1) & "," & arr2(i, 2) & "," & arr2(i, 3)
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
If x = 1 Then GoTo ren
End If
Next i
Loop
ren:
TextBox1.Text = Label6.Caption
d(i) = ""
z = Me.ComboBox2.Text - 1
If z > y Then
Me.ComboBox2.Text = y - 1
z = Me.ComboBox2.Text
End If
Do
zzz = zzz + 1
If zzz > 1000 Then Exit Sub
If z < 1 Then Exit Do
j = Fix(Rnd() * y + 1)
For j = j To y
If Not d.Exists(j) Or d.Count > y - 2 Then
z = z - 1
Label6.Caption = Me.ComboBox1.Text & ":" & arr2(j, 1) & "," & arr2(j, 2) & "," & arr2(j, 3)
TextBox1.Text = TextBox1.Text & Chr(13) & Chr(10) & Label6.Caption
d(j) = ""
Exit For
End If
Next j
Loop
TextBox2.Text = TextBox1 & Chr(13) & Chr(10) & Chr(13) & Chr(10) & TextBox2.Text
End Sub
Private Sub CommandButton2_Click()
x = 1
End Sub
Private Sub UserForm_Activate()
Set d = CreateObject("Scripting.Dictionary")
Me.ComboBox1.AddItem ""
Me.ComboBox1.AddItem "三等奖"
Me.ComboBox1.AddItem "二等奖"
Me.ComboBox1.AddItem "一等奖"
Me.ComboBox1.AddItem "特等奖"
Me.ComboBox1.Text = "三等奖"
Me.ComboBox2.Text = 1
For i = 1 To 30
Me.ComboBox2.AddItem i
Next i
End Sub
|
|