|
Private Sub CmdGo_Click()
Dim Cn As New ADODB.Connection, Rs As New ADODB.Recordset, sqlStr As String
Set Cn = CurrentProject.Connection
'第一步,先将当天导师有上班的的优先安排给学生===================================================================================================================
sqlStr = "SELECT 学生姓名,日期,导师姓名,带教 FROM 安排 ORDER BY 日期"
Rs.Open sqlStr, Cn, adOpenKeyset, adLockPessimistic '后面两个参数不可省,否则无法更新资料
Do Until Rs.EOF
If IsNull(DLookup("[带教1]", "带教查询", "[日期]=#" & Rs("日期") & "# AND [带教1]='" & Rs("导师姓名") & "'")) = False Then '如果学生当天的导师有上班的话
Rs!带教 = Rs!导师姓名
End If
Rs.Update
Rs.MoveNext
Loop
Rs.Close
'第二步,取得没有分配带教老师的记录(以学生的优先次序排序),然后按带教老师的优先次序予以分配=====================================================================
Dim Rs2 As New ADODB.Recordset, sqlStr2 As String
sqlStr = "SELECT 安排.学生姓名, 安排.日期 FROM 学生优先次序 INNER JOIN 安排 ON 学生优先次序.学生姓名 = 安排.学生姓名 WHERE 安排.带教 Is Null ORDER BY 学生优先次序.优先次序"
Rs.Open sqlStr, Cn
Do Until Rs.EOF
sqlStr2 = "SELECT 带教查询.带教1 FROM 带教查询 INNER JOIN 带教优先次序 ON 带教查询.带教1 = 带教优先次序.带教姓名 WHERE 带教查询.日期=#" & Rs!日期 & "#" & _
" ORDER BY 带教优先次序.优先次序"
Rs2.Open sqlStr2, Cn
Do Until Rs2.EOF
If IsNull(DLookup("[日期]", "安排", "[日期]=#" & Rs!日期 & "# AND [带教]='" & Rs2!带教1 & "'")) = True Then '当天此老师尚未安排带教,则排上并退出循环
Cn.Execute ("UPDATE 安排 SET 带教='" & Rs2!带教1 & "' WHERE 学生姓名='" & Rs!学生姓名 & "' AND 日期=#" & Rs!日期 & "#")
Exit Do
End If
Rs2.MoveNext
Loop
Rs2.Close
Rs.MoveNext
Loop
Rs.Close
'第三步,通过上面两步,解决了导师带自己的学生,和每个导师都有学生可带(当然前提是经第一步后有学生没导师带)====================================================
'在此步中,只需按照学生的优先顺序,以及导师的优先顺序,以及导师已经带教的学生数进行带教的排班
'如果优先的导师带教的学生在当天是最少的,则将尚未分配导师的优先的学生分配给他,否则看第二优先的导师带教的学生在当天是最少的……依次类推
Dim DJ As String
Rs.Open sqlStr, Cn
Do Until Rs.EOF
DJ = ""
sqlStr2 = "SELECT 带教查询.带教1 FROM 带教查询 INNER JOIN 带教优先次序 ON 带教查询.带教1 = 带教优先次序.带教姓名 WHERE 带教查询.日期=#" & Rs!日期 & "#" & _
" ORDER BY 带教优先次序.优先次序"
Rs2.Open sqlStr2, Cn
Do Until Rs2.EOF
'下面选择语句用来判断当前的带教老师已经带教学生的数量,得到选出带教人数最少的导师
If DJ = "" Then
DJ = Rs2!带教1
Else
If DCount("*", "安排", "[日期]=#" & Rs!日期 & "# AND [带教]='" & Rs2!带教1 & "'") < DCount("*", "安排", "[日期]=#" & Rs!日期 & "# AND [带教]='" & DJ & "'") Then
DJ = Rs2!带教1
End If
End If
Rs2.MoveNext
Loop
Rs2.Close
Cn.Execute ("UPDATE 安排 SET 带教='" & DJ & "' WHERE 学生姓名='" & Rs!学生姓名 & "' AND 日期=#" & Rs!日期 & "#")
Rs.MoveNext
Loop
Set Rs2 = Nothing
Rs.Close
Set Rs = Nothing
Set Cn=Nothing
MsgBox "完成"
'这里还存在一点问题尚未解决,就是优先的学生不一定能够分配给优先的导师,如学生A是优先级第一的,导师A是优先级第一,导师B次之,设当天共有学生4人(A,B,C,D),学生B的导师是导师A,其它学生的导师当天均无带教任务
'所以在第一步就已经将学生B分配给导师A,在第二步就将学生A分配给了导师B,而不能像理想中的排法:学生B<>导师A、学生A<>导师A、学生C<>导师B、学生D<>导师B
'程序最终取得的结果将是:学生B<>导师A、学生A<>导师B、学生C<>导师A、学生D<>导师B
End Sub |
|