程序代码：

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]

原表数据.JPG (27.44 KB)

图片附件: 游客没有浏览图片的权限，请 登录 或 注册

结果.JPG (28.41 KB)

图片附件: 游客没有浏览图片的权限，请 登录 或 注册