ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1427|回复: 0

[求助] 【已解决】PPT滚动随机抽取一名中奖者

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-11-23 09:54 | 显示全部楼层 |阅读模式
本帖最后由 土豆刺客 于 2017-11-23 10:23 编辑

下面的代码是同时随机抽取15名中奖者的代码,也是论坛上的。
怎么改成随机抽取一人的情况啊,研究了一个早上没结果。大思路就是,按下开始键后从一个textbox的名单列表中随机提取到另一个textbox中,并且做一个循环,直到按下停止键为止。
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim arrRM, F
Private Sub CommandButton1_Click()
    If Me.CommandButton1.Caption = "停" Then
        Me.CommandButton1.Caption = "开始"
        Call CQ_do("stop")
    Else
        Me.CommandButton1.Caption = "停"
        Call CQ_do("start")
    End If
End Sub

Private Sub CQ_do(doTag)
    If doTag = "start" Then
        arrRM = Split(Me.TextBox1, ";", -1, 1)

        F = 0
        Do While True
            Sleep 30

            Dim i As Integer, j As Integer, a(0 To 14) As String
            Randomize
            For i = 0 To 14
1:
                a(i) = Int((UBound(arrRM) + 1) * Rnd)
                For j = i - 1 To 0 Step -1
                    If a(i) = a(j) Then
                        GoTo 1
                    End If
                    DoEvents
                Next

            Next
            TextBox2.Text = arrRM(a(0))
            TextBox5.Text = arrRM(a(1))
            TextBox6.Text = arrRM(a(2))
            TextBox7.Text = arrRM(a(3))
            TextBox8.Text = arrRM(a(4))
            TextBox9.Text = arrRM(a(5))
            TextBox10.Text = arrRM(a(6))
            TextBox11.Text = arrRM(a(7))
            TextBox12.Text = arrRM(a(8))
            TextBox13.Text = arrRM(a(9))
            TextBox14.Text = arrRM(a(10))
            TextBox15.Text = arrRM(a(11))
            TextBox16.Text = arrRM(a(12))
            TextBox17.Text = arrRM(a(13))
            TextBox18.Text = arrRM(a(14))
            If F = 1 Then Exit Do
            DoEvents
        Loop
    Else
        F = 1
    End If
End Sub

论坛里的代码如下:
'代码注释部分用于调试,或者你可以修改为其他用途,比如可以显示给用户观看。
Private Sub CommandButton1_Click()
    If Me.CommandButton1.Caption = "停" Then
        Me.CommandButton1.Caption = "开始"
        Call CQ_do("stop")
    Else
        Me.CommandButton1.Caption = "停"
        Call CQ_do("start")
    End If
End Sub


Private Sub CQ_do(doTag)
    Dim I
    If doTag = "start" Then
        arrRM = Split(Me.TextBox1, ";", -1, 1) '如果有需要你可以替换这里的空格,改为你需要的分隔符: 如个为英文分号 Split(Me.TextBox1, ";", -1, 1)
'        TextBox3 = ""
'        TextBox3.Visible = True
'        TextBox4.Visible = True
'        Me.TextBox4 = UBound(arrRM) & " " & arrRM(0) & " " & arrRM(UBound(arrRM))
        F = 0
        Do While True
            Sleep 30
            I = Int(((UBound(arrRM) + 1) * Rnd) + 0)
'            TextBox3 = TextBox3 & "-" & I
            TextBox2.Text = arrRM(I)
            If F = 1 Then Exit Do
            DoEvents
        Loop
    Else
        F = 1
    End If
End Sub



您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-22 15:01 , Processed in 0.022589 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表