标题: vba随机均匀分组 [打印本页] 作者: lhlprc 时间: 2016-7-29 10:01 标题: vba随机均匀分组 各位老师：
我现在要将这93个数据随机分组，要求分成5组，每个组的数据个数相差在2个以内，分完组后，还要求每个组的分数平均值差距在2分以内。这歌要怎么写代码呀?
请老师指导，万分感谢！作者: wzl8007 时间: 2016-7-29 17:28
access 应该能实现， 分班问题！作者: wzl8007 时间: 2016-7-29 21:18
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 时间: 2016-7-30 08:18
传个实例，仅供参考，如果长时间运行，请中断，然后重启程序继续！作者: lhlprc 时间: 2016-7-30 13:37
谢谢老师了。不好意思，但是我不懂access，我只有vba的一点点基础，这个代码要写在哪呀作者: wzl8007 时间: 2016-7-30 20:50
分班结果作者: lhlprc 时间: 2016-7-31 16:49