vba随机均匀分组

wzl8007

access 应该能实现， 分班问题！

wzl8007

Private Sub Command0_Click()
Dim aa As Integer
aa = 597
Dim Conn1 As New ADODB.Connection
    Dim Rs_Date As New ADODB.Recordset
    Set Conn1 = CurrentProject.Connection
    Dim Arr_Date()
    Dim sql As String
    Dim rstCount As Integer
   Do While True
   CurrentDb.Execute "select * into 一班 from (SELECT TOP 18 Sheet1.序号, Sum(Sheet1.分数) AS 成绩合成之合计 FROM Sheet1 where 分组 is null GROUP BY Sheet1.序号 ORDER BY Rnd(-(序号+Rnd())))"
        Application.RefreshDatabaseWindow
        sql = "SELECT round(Sum(一班.成绩合成之合计)) AS 班级成绩总和 FROM 一班"
Rs_Date.Open sql, Conn1, 3, 3
    If Abs(Round(Rs_Date(0) / 18) - aa) < 1 Then
    Debug.Print Round(Rs_Date(0) / 18)
    GoTo line
    End If
    Rs_Date.Close
    Set Rs_Date = Nothing
    DoCmd.DeleteObject acTable, "一班"
    Loop
line:
    CurrentDb.Execute "update sheet1 set 分组='一班' where 序号 in (select 序号 from 一班)"
MsgBox "一班完成！"
    Rs_Date.Close
    Set Rs_Date = Nothing
End Sub
access 能完成！

wzl8007

传个实例，仅供参考，如果长时间运行，请中断，然后重启程序继续！

wzl8007

分班结果

wzl8007

不太明白你的意思

wzl8007

我完善了系统，有要求的话：qq：398157859

wzl8007

http://www.office-cn.net/thread-122019-1-1.html可以参考我做的这个程序！