能力有限，真搞不定，求救！

jx928867128

教师监考安排规则说明：

ynzsvt

三列任课复制成六列监考，然后运行程序后微调。

1. Sub pske()
   
2. Dim Arr, i&, j&, j1&, k&, Dic As Object, Dic1 As Object, Tmp
   
3. Set Dic = CreateObject("Scripting.Dictionary")
   
4. Set Dic1 = CreateObject("Scripting.Dictionary")
   
5. Arr = [B1:H10]
   
6. For j = 1 To 4
   
7.   Dic1.RemoveAll
   
8.   For i = 1 To 10
   
9.    k = 0
   
10.    Do
    
11.     Tmp = Arr(i, j)
    
12.     Dic(Tmp) = Dic(Tmp) + 1
    
13.     If Dic1.Exists(Arr(i, j)) Or Dic(Tmp) > 4 Then
    
14.      k = k + 1
    
15.      If k > 2 Then Arr(i, 7) = j & Tmp & Dic(Tmp): Exit Do
    
16.      For j1 = j To 6 - 1
    
17.       Arr(i, j1) = Arr(i, j1 + 1)
    
18.      Next j1: Arr(i, j1) = Tmp
    
19.      Dic(Tmp) = Dic(Tmp) - 1
    
20.     Else
    
21.      Dic1(Tmp) = "": Exit Do
    
22.     End If
    
23.    Loop
    
24.   Next i
    
25. Next j
    
26. [B1:H10] = Arr
    
27. Set Dic1 = Nothing
    
28. Set Dic = Nothing
    
29. End Sub

复制代码

jx928867128

ynzsvt 发表于 2024-6-16 11:05
三列任课复制成六列监考，然后运行程序后微调。

谢谢您的关注与回贴

jx928867128

这个问题不知道有没有表达清楚了吗，求回复

longwin

现有条件排6个科目的考试还能排出来，7个科目以上都没解出来，你可以手工排排试试。建议按照实际情况调整一下教师任课表，目前这样无解的情况太多没有意义。

wang-way

你不是一小时可以搞定吗

wang-way

ynzsvt 发表于 2024-6-16 11:05
三列任课复制成六列监考，然后运行程序后微调。

排出来看看

ynzsvt

https://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1694924&pid=11522420

代码未考虑必须监考一次，手工调整。

wang-way

楼主连模拟数据都不认真弄一下？

jx928867128

longwin 发表于 2024-6-16 16:59
现有条件排6个科目的考试还能排出来，7个科目以上都没解出来，你可以手工排排试试。建议按照实际情况调整一 ...

谢谢老师的帮忙，当前附件排6个科目可以排出的附件方便发出来吗