关于排课

ws1544925

ovxyz 发表于 2023-5-17 14:55
你这个要求说得还是不清楚，例如上课时间是不是40分钟？
并且这个组合会有很多种结果。是随机展示一种还是 ...

抱歉，是我没想到有这么多细节。
和上课时长没有关系， 不需要最优解， 只要实现结果就行。
即每节课都有老师上课，  每个老师上1节课， 老师上课时间是在他能上课的时间点。

ws1544925

leeson7502 发表于 2023-5-17 16:48
楼主的模拟表可能不太合适，我给你重搞了一下。详见附件。

谢谢， 我先下载理解一下

ws1544925

leeson7502 发表于 2023-5-17 16:48
楼主的模拟表可能不太合适，我给你重搞了一下。详见附件。

感谢意见。  我看到附件是 每个老师按照顺序循环排课。  
需求还有一个前提条件，每一个老师能上课的时间是不一样的。  老师上课需要符合在他能上课的时间点。

ws1544925

ovxyz 发表于 2023-5-17 11:31
没看太懂，是这个意思吗？

图片里边处理结果， 下一步 怎么让每个时段就只有一个老师， 且不重复呢

yynrzwh

排班排课似乎要用到很复杂的算法，我不会。
下面贴一个笨的，随机生成

1. Sub 排课()
   
2. 
   
3. arr = Sheet1.[a1].CurrentRegion
   
4. Range("O2:O100").Clear
   
5. Set d = CreateObject("scripting.dictionary")
   
6. 
   
7. '随机生成一组结果，以数字1-10表示10位老师
   
8. 1:    Do While d.Count < 10
   
9.         a = WorksheetFunction.RandBetween(1, 10)
   
10.         If Not d.exists(a) Then
    
11.             n = n + 1
    
12.             d(a) = n
    
13.         End If
    
14.       Loop
    
15. 
    
16. '验证是否符合条件
    
17.     For i = 2 To UBound(arr)
    
18.         m = Application.Index(d.keys, i - 1)
    
19.             If arr(i, m + 2) = 1 Then
    
20.                 k = k + 1
    
21.                 If k = 10 Then GoTo 2 '全部符合条件，跳到2输出结果
    
22.             Else
    
23.                 d.RemoveAll
    
24.                 k = 0
    
25.                 GoTo 1 '不符合条件，跳到1重新生成一组结果
    
26.             End If
    
27.     Next i
    
28. 
    
29. '输出结果
    
30. 2:
    
31.     ReDim brr(1 To 10)
    
32.     For Each kk In d.keys
    
33.         k1 = k1 + 1
    
34.         brr(k1) = arr(1, kk + 2)
    
35.     Next kk
    
36. Sheet1.Range("O2").Resize(UBound(brr)) = Application.Transpose(brr)
    
37. Set d = Nothing
    
38. End Sub
    

复制代码

ws1544925

leeson7502 发表于 2023-5-17 20:17
那你要给出数据啊，你是如何确定哪个老师能上哪些时间？

示例里边 对应时间段 标记 1 就代表老师能在这个时间段上课

135294560056

题目例子有问题，你的班级呢？还有课程安排呢？不清楚的话建议以真实例子进行举例；否则没法排；应该先明确班级数、各班级的课程数，若每名教师都是专一的，还要明确各科教师数，然后用穷举法计算不冲突的排课方案，在根据其他因素（如课时集中度、距离集中度）进行比选最优方案

yynrzwh

有没有懂遗传算法的老师写一个学习一下？