Private Sub Command6_Click() '''重新排序注册人员Dim sql1 As String
Dim sql2 As String
Dim rg As ADODB.Recordset
Dim i As Integer
Dim j As Integer
i = 0
Dim mysql As String
Dim mytext As String
Dim mymrc As ADODB.Recordset
Dim msgtextt As String Dim mrcs As ADODB.Recordset
Do While i < subno ''''原表中的数据行数
Randomize
j = Int(12 * Rnd)
sql1 = "select * from 重排 where 原序号='" & j & "'"
Set mrcs = ExecuteSQL(sql1, msgtextt)
If mrcs.EOF Then ''''判断在新表中是否存在 原序号数==随机数的数据mrcs.Close
'************************************
'*** 若不存在 查询旧表中序号为随机数数据写入新表 '************************************
mysql = "select * from 注册 where 人员编号='" & j & "'"
Set mymrc = ExecuteSQL(mysql, mytext)
sql2 = "select * from 重排"
Set rg = ExecuteSQL(sql2, mytext)
rg.AddNew
rg!人员编号 = i
rg!原序号 = mymrc.Fields(0)
rg!人员照片 = mymrc.Fields(1)
rg!是否中奖 = mymrc.Fields(2)
rg.Update
rg.Close
'***********************************
'***********************************
'MsgBox j
i = i + 1
mymrc.Close
End If
Loop
MsgBox "重排完成"
End Sub
后来改了下算法,先生成不重复的随机数,存在数组中,在根据数据的顺序排序原表。