主题：随机抽取的问题

帮助文档洗牌有问题，换一种方式

http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=86672&skin=0

你控制好洗牌次数（越多越好），就可以洗得很乱了；再有就是选取数据的时候，你不一定是从上往下选取10行嘛，选取数据的时候，你还能再随机选10个。

1、ids存放的是行号，不是你的指标列的数据；

2、红色代码表示上次的行号，请自行用全局变量存放其值

Dim pids() As String = "1,3,5,9,10,12,20,15,16,17".split(",")

Dim dt As DataTable = DataTables("表C")
Dim cnt As Integer = dt.DataRows.Count
Dim ids(cnt - 1) As Integer
For i As Integer = 0 To cnt - 1
    ids(i) = i
Next
For i As Integer = 0 To cnt \ 3 '洗牌次数
    Dim id1 As Integer = rand.Next(100,cnt)
    Dim id2 As Integer = rand.Next(100,cnt)
    Dim vid As Integer = ids(id1)
    ids(id1) = ids(id2)
    ids(id2) = vid
Next
dt.StopRedraw()
DataTables("表C").ReplaceFor("选择",False)
Dim count As Integer = 0

Do While count < 5
    Dim rnd As Integer = Rand.Next(0, 10)
    If DataTables("表C").DataRows(pids(rnd))("选择") = False Then
        count += 1
        DataTables("表C").DataRows(pids(rnd))("选择") = True
    End If
Loop

Do While count < 10
    Dim rnd As Integer = Rand.Next(0, cnt)
    If DataTables("表C").DataRows(ids(rnd))("选择") = False Then
        count += 1
        DataTables("表C").DataRows(ids(rnd))("选择") = True
    End If
Loop
Tables("表C").Filter = "[选择] = True"
dt.ResumeRedraw()

全局代码

public pstr As String = ""

按钮代码

Dim pids() As String = pstr.split(",")
Dim num As Integer = 20
pstr = ""

Dim dt As DataTable = DataTables("表C")
Dim cnt As Integer = dt.DataRows.Count
Dim ids(cnt - 1) As Integer
For i As Integer = 0 To cnt - 1
    ids(i) = i
Next
For i As Integer = 0 To cnt \ 3 '洗牌次数
    Dim id1 As Integer = rand.Next(0,cnt)
    Dim id2 As Integer = rand.Next(0,cnt)
    Dim vid As Integer = ids(id1)
    ids(id1) = ids(id2)
    ids(id2) = vid
Next
dt.StopRedraw()
DataTables("表C").ReplaceFor("选择",False)
Dim count As Integer = 0

If pids.length >= num / 2
    Do While count < num / 2
        Dim rnd As Integer = Rand.Next(0, pids.length)
        If DataTables("表C").DataRows(pids(rnd))("选择") = False Then
            count += 1
            DataTables("表C").DataRows(pids(rnd))("选择") = True
            pstr &= pids(rnd) & ","
        End If
    Loop
End If
Do While count < num
    Dim rnd As Integer = Rand.Next(0, cnt)
    If DataTables("表C").DataRows(ids(rnd))("选择") = False Then
        count += 1
        DataTables("表C").DataRows(ids(rnd))("选择") = True
        pstr &= ids(rnd) & ","
    End If
Loop
Tables("表C").Filter = "[选择] = True"
dt.ResumeRedraw()
pstr = pstr.trim(",")
msgbox(pstr)