如何按要求排课表？

作者：绿色风分类：时间：2022-08-17 浏览：113

楼主悟空师弟	Q：如何按要求排课表？如下图：要求实现： 1、每天上午至少有一节语文和数学课。 2、语文、数学每天不能多于两节，其它科目每天不能超过1节。说明：上午4节，下午两节。 A：VBA代码如下：附件：模拟排课.rar Sub pk() Range("E2:J6") = "" Dim rg As Range Dim rng As Range Dim rngkg As Range Set rngkb = Range("E2:F6") For Each rg In Range("A1:A2") For rw = 2 To 6 For x = 1 To 99999999 cl = Int(Rnd() * 4 + 5) If Cells(rw, cl) = "" Then Cells(rw, cl) = rg Exit For End If Next x Next rw Next rg For Each rg3 In Range("A1:A2") For rw2 = 2 To 6 cl2 = Int(Rnd() * 2 + 9) For x2 = 1 To 99999999 If Cells(rw2, cl2) = "" Then Cells(rw2, cl2) = rg3 Exit For Else Exit For End If Next x2 If Application.CountIf(Range("E2:J6"), rg3) >= rg3.Offset(0, 1) Then Exit For End If Next rw2 Next rg3 For Each rg4 In Range("A3:A11") For x = 1 To 99999999 rw = Int(Rnd() * 5 + 2) cl = Int(Rnd() * 6 + 5) If Application.CountIf(Range(Cells(rw, 5), Cells(rw, 10)), rg4) < 1 Then If Len(Cells(rw, cl)) = 0 Then Cells(rw, cl) = rg4 y = y + 1 If y >= rg4.Offset(0, 1) Then Exit For End If End If End If Next x y = 0 Next rg4 End Sub 效果如下：
2楼微风入林	我抢我快乐
3楼绿篱	感谢分享学习啦~~
4楼 hnfgcjh	EXCEL中真可以排课程表啊！

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表