vba随机均匀分组

lhlprc

各位老师：
我现在要将这93个数据随机分组，要求分成5组，每个组的数据个数相差在2个以内，分完组后，还要求每个组的分数平均值差距在2分以内。这歌要怎么写代码呀?
请老师指导，万分感谢！

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

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

lhlprc

谢谢老师了。不好意思，但是我不懂access，我只有vba的一点点基础，这个代码要写在哪呀
来自: 微社区

wzl8007

分班结果

lhlprc

wzl8007 发表于 2016-7-30 20:50
分班结果

谢谢老师，我试用了，能运行。这个能用vba完成吗？

lhlprc

wzl8007 发表于 2016-7-30 08:18
传个实例，仅供参考，如果长时间运行，请中断，然后重启程序继续！

这个能不能用随机数产生班级编号，让产生的班级编号满足个班随机的人数，然后把满足条件的班级标号直接添加进去分班结果。

wzl8007

不太明白你的意思

wzl8007

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