![]() |
#2
Artless2013-01-12 14:39
|

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 < 11 ''''原表中的数据行数
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
'***********************************
'***********************************
i = i + 1
mymrc.Close
End If
Loop
MsgBox "重排完成"
End Sub
[local]1[/local][local]2[/local]
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 < 11 ''''原表中的数据行数
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
'***********************************
'***********************************
i = i + 1
mymrc.Close
End If
Loop
MsgBox "重排完成"
End Sub
[local]1[/local][local]2[/local]
[ 本帖最后由 飞天丫头 于 2013-1-12 10:21 编辑 ]