110分 求一个类似摇奖的随机先取数据库中的数据的代码 帮顶有分了 110分

Question

求一个类似摇奖的随机先取数据库中的数据的代码
两个按钮一个开始，文本框！随机！（向下滚动）显示数据库中的一些文本信息（最好速度快一些看不出来具体是什么文本），另一个钮停止，在文本框中显示按停止钮时随机产生的文本。
最好还有个组选按钮就是一次性随机选取多条信息。
也可以不用数据库而直接在程序里设置程序的内容也可以，但最好是数据库
本人是初学者，经常问问题，所以分比较少了，只有十分了，但希望您在代码中加一些注示，感谢感谢。
http://community.csdn.net/Expert/topic/5675/5675532.xml?temp=.4819605这个页面里还10分，一起给了。本人初学者，希望大家体谅，谢谢了。

Answer 1

楼上说的对，也可以用rs的AbsolutePosition属性来处理，除了那个贴子的方法，下面这个不用数组了，不过要一直连接着数据库：Dim cn As ADODB.Connection
Dim rs As ADODB.RecordsetPrivate Sub Command1_Click()
    Timer1.Enabled = True
End SubPrivate Sub Command2_Click()
    Timer1.Enabled = False
End SubPrivate Sub Form_Load()    Dim sql As String
    
    Set cn = New ADODB.Connection
    cn.CursorLocation = adUseClient
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " _
        & "Data Source=" & App.Path & "\db.mdb;Persist " _
        & "Security Info=False;Jet OLEDB:Database Password=123"    sql = "select [number] from tb "
    Set rs = cn.Execute(sql)
    
    Timer1.Interval = 100
    Timer1.Enabled = False
End SubPrivate Sub Timer1_Timer()
    Dim r As Integer
    
    Randomize
    r = Int(rs.RecordCount * Rnd) + 1
    rs.AbsolutePosition = r
    Text1 = rs(0)
End Sub反正简单实现有许多方法，要做到移动的效果，到要动下脑筋

Answer 2

高手就是高手啊佩服佩服，遇到高手多问一句。我想组选可以吗？就是一次性随机选择多个数据比如说三个人吧，这三个人要组选的时候三个人之间不能重复，还要每次组选的时候不能总这三个人一组，其它两个随机产生的数据显示在另两个textbox里。初学者要求还比较多希望您体谅，谢谢高手了，最好您方便给我加些注示。

Answer 3

哈哈哈哈我去年帮一个雅马哈的朋友写了一个,与你的要求一模一样啊是不是还要可以从人事部的EXCEL表里导入人员名单,结束后还要把结果导出到EXCEL?

Answer 4

是啊高手，跟我想要的一样啊，来一份啊，谢谢了，我再另给您发个帖子给您100分，这个里前几位已经帮了我不少了，我想把分给他们，最好有个实例[email protected]

Answer 5

我根据上面高手的代码自己改写如下，但总有重复的怎么办啊？
Option ExplicitDim arr() As String    '存放号码的数组Private Sub Command1_Click()
    Timer1.Enabled = True      '开启
End SubPrivate Sub Command2_Click()
    Timer1.Enabled = False     '关闭
End SubPrivate Sub Form_Load()    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Single
    Dim sql As String
    
'连接ACCESS数据库
    Set cn = New ADODB.Connection
    cn.CursorLocation = adUseClient
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " _
        & "Data Source=" & App.Path & "\db.mdb;Persist " _
        & "Security Info=False;Jet OLEDB:Database Password=123"'返回所有号码的记录集
    sql = "select [number] from tb "
    Set rs = cn.Execute(sql)'将记录集中的号码赋值给数组
    ReDim arr(1 To rs.RecordCount)
    For i = 1 To rs.RecordCount
        arr(i) = rs(0)
        'Debug.Print arr(i)
        rs.MoveNext
    Next'释放对象
    Set rs = Nothing
    Set cn = Nothing'设置timer控件
    Timer1.Interval = 6
    Timer1.Enabled = False
End SubPrivate Sub Timer1_Timer()'随机显示号码
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim d As Integer
    Dim e As Integer
    Dim f As Integer
    Dim g As Integer
    Dim h As Integer
    Dim i As Integer
    Dim j As Integer    Randomize
    a = Int(UBound(arr) * Rnd) + 1
    Text1 = arr(a)
    Randomize
    b = Int(UBound(arr) * Rnd) + 1
    Text2 = arr(b)
    Randomize
    c = Int(UBound(arr) * Rnd) + 1
    Text3 = arr(c)
    Randomize
    d = Int(UBound(arr) * Rnd) + 1
    Text4 = arr(d)
    Randomize
    e = Int(UBound(arr) * Rnd) + 1
    Text5 = arr(e)
    Randomize
    f = Int(UBound(arr) * Rnd) + 1
    Text6 = arr(f)
    Randomize
    g = Int(UBound(arr) * Rnd) + 1
    Text7 = arr(g)
    Randomize
    h = Int(UBound(arr) * Rnd) + 1
    Text8 = arr(h)
    Randomize
    i = Int(UBound(arr) * Rnd) + 1
    Text9 = arr(i)
    Randomize
    j = Int(UBound(arr) * Rnd) + 1
    Text10 = arr(j)End Sub

Answer 6

每一次拿到一个数后，就放入一个地方（如Collection),用Collection比较简单实现，把这个数作为Key放到入去，成功就证明之前无，失败就是有。

Answer 7

有重复这样修改一下,text控件用数组：Private Sub Timer1_Timer()'随机显示号码
    Dim n() as integer
    dim r as integer,k as integer    redim n(1 to ubound(arr))
        
    Randomize
    
    while k < 10
        r = Int(UBound(arr) * Rnd) + 1
        if n(r)=0 then
            text1(k)=arr(r)       'text1(0)到text(9)
            n(r)=1
            k=k+1
        end if
    wend
    
End Sub