|
删除集合元素代码有误,特此纠正:- Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '参数是长整形(毫秒数)。Lib “kernel32”标明这个函数是引用kernel32.dll提供的函数。Kernel32.dll是windows的四个核心库之一。是用来延时n毫秒的?
- Dim s As New Collection, f As Boolean, j%, n%, temp '接受函数返回数组的temp不能 As String;不关闭ppt,上次的arr将一直存在,这是与在下面声明的差异
- Private Sub CommandButton1_Click()
- Dim i%, r%
- If s.Count < 50 And j = 0 Then '不能用s.Count=0,连续调试时避免中断执行造成少于50个元素存在,一开始就无法进行j=1的初始化
- TextBox2.Text = "" '清除界面的上次奖等数据
- TextBox4.Text = ""
- TextBox5.Visible = False
- TextBox6.Visible = False
- TextBox7.Visible = False
- TextBox8.Visible = False
- TextBox5.Text = ""
- TextBox6.Text = ""
- TextBox7.Text = ""
- TextBox8.Text = ""
- Set s = Nothing
- For i = 1 To 50 '抽奖号码准备
- s.Add 800 + i, CStr(800 + i)
- Next
- j = 1 '抽奖序次初始化
- TextBox4.Text = "三等奖"
- End If
- f = False
- If Me.CommandButton1.Caption = "停止" Then
- Me.CommandButton1.Caption = "开始"
- f = True
- Else
- Me.CommandButton1.Caption = "停止"
- 'MsgBox f & j '因只能在放映模式使用按钮,调试时变量监控点
- n = --Mid(3321, j, 1) '抽取奖等的个数
- Do
- If f Then
- Select Case j '操作汇奖区
- Case 1
- TextBox5.Text = temp(0) & " " & temp(1) & " " & temp(2)
- TextBox5.Visible = True
- Sleep 80 '延时让抽中号码有机会显示在抽奖区,而非一闪而过飘到汇奖区,调试改为800
- TextBox1.Text = ""
- TextBox2.Text = ""
- TextBox3.Text = ""
- Case 2
- TextBox6.Text = temp(0) & " " & temp(1) & " " & temp(2)
- TextBox6.Visible = True
- Sleep 80
- TextBox1.Text = ""
- TextBox2.Text = ""
- TextBox3.Text = ""
- Case 3
- TextBox7.Text = temp(0) & " " & temp(1)
- TextBox7.Visible = True
- Sleep 80
- TextBox1.Text = ""
- TextBox3.Text = ""
- Case 4
- TextBox8.Text = temp(0)
- TextBox8.Visible = True
- TextBox2.Text = ""
- End Select
- 'MsgBox n & j '调试时变量监控点
- j = j + 1
- If j = 5 Then
- MsgBox "抽奖完毕!"
- j = 0
- Exit Sub
- Else
- For i = 0 To n - 1
- s.Remove (temp(i)) '滤除已抽取号码
- Next
- End If
- TextBox4.Text = Mid("三二一特", j, 1) & "等奖" '显示待抽的下一奖等
- Exit Do
- Else
- temp = choose(50 - Mid("0368", j, 1), n) '扣减已抽取样本数量,50-Mid("0368", j, 1)选n
- For i = 0 To n - 1 '由于temp抽取的序号并未排序,s.remove时可能会造成s(--temp(i))中--temp(i)的变动和丢失,故在remove之前存好s(--temp(i)),而非存序号
- temp(i) = s(--temp(i)) & "" 'choose作为字典的key已置为文本
- Next
- Select Case n '下框的抽奖区即时显示具体抽中号码
- Case 3
- TextBox1.Visible = True '因上次抽特等奖时将其隐藏
- TextBox3.Visible = True
- TextBox1.Text = temp(0)
- TextBox2.Text = temp(1)
- TextBox3.Text = temp(2)
- Case 2
- TextBox1.Text = temp(0)
- TextBox2.Visible = False
- TextBox3.Text = temp(1)
- Case 1
- TextBox1.Visible = False
- TextBox2.Visible = True
- TextBox3.Visible = False
- TextBox2.Text = temp(0)
- End Select
- End If
- Sleep 30
- DoEvents
- Loop
- End If
- End Sub
- Function choose(m%, n%) '传回数组的函数不能声明为String,必须为vaiant
- Dim i%, dt
- Set dt = CreateObject("Scripting.Dictionary")
- Randomize
- Do
- i = Int(Rnd * (m - 1)) + 1
- dt(i & "") = "" '用字典的key来确保不重复抽取
- Loop Until dt.Count = n
- choose = dt.keys
- End Function
复制代码 |
|