请教大侠：如何根据总课表的节次自动生成可以代课的老师名单

yijijie

如何根据总课表的节次自动生成可以代课的老师名单，实在是想不出思路~

是不是要用VBA？请教高手，谢谢

2024年春课程表.rar (56.52 KB, 下载次数: 13)

2024-3-14 21:45 上传

点击文件名下载附件

最后给代码写了备注，优化了一下框的形状，再次感谢 3190496160
共享最终文件：
2024年春课程表原改.rar (67.08 KB, 下载次数: 2)

2024-3-17 12:11 上传

点击文件名下载附件

3190496160

Private Sub Worksheet_SelectionChange(ByVal T As Range)
ActiveWindow.Zoom = 100
If T.Row > 4 Then
    If T.Count > 1 Then End
    r = Cells(Rows.Count, 3).End(xlUp).Row - 6
    y = Cells(3, Columns.Count).End(xlToLeft).Column
    x = T.Row: w = T.Column
    If x > r Or w > y Then ListBox1.Visible = False: End
    MsgBox r
    If Not IsNumeric(T.Value) Then End
    Dim d As Object, dc As Object
    Set d = CreateObject("scripting.dictionary")
    Set dc = CreateObject("scripting.dictionary")
    bj = Cells(3, w)
    For j = 3 To y
        If Cells(x, j) <> "" Then dc(Cells(x, j).Value) = ""
    Next j
    For j = 3 To y
        If Cells(3, j) = bj Then
            For i = 6 To r
                If i <> x Then
                    If Cells(i, j) <> "" Then
                        If Cells(i, j) <> T.Value Then
                            If IsNumeric(Cells(i, j)) Then
                                If Not dc.exists(Cells(i, j).Value) Then
                                    d(Cells(i, j).Value) = ""
                                End If
                            End If
                        End If
                    End If
                End If
            Next i
        End If
    Next j
    If d.Count = 0 Then End
    [ar1].Resize(1, d.Count) = d.keys
    With ListBox1
        .Visible = True
        .Top = T.Top + 15
        .Left = T.Left + 10
        .List = d.keys
    End With
End If
End Sub

3190496160

2024年春课程表.rar (67.13 KB, 下载次数: 7)

2024-3-15 09:10 上传

点击文件名下载附件

3190496160

结果未认真核对，仅供参考

yijijie

谢谢大师，顶礼膜拜！
在我思路都不知道的情况下，你已经写出了代码，我下来好好学习学习

yijijie

3190496160 发表于 2024-3-15 09:11
结果未认真核对，仅供参考

认真看了结果，发现一个小问题，不知道能不能修复？
目前得出的结果是：候选框里面的老师编号是星期一至星期五该节课均不出现的才显示出来，而我们实际情况是只要被点击的这一天这个节次没有课就可以安排。
如图所示，25号老师请假，其实1、22、33号老师也是可以安排的，不会受到星期四的课时的影响。

3190496160

yijijie

3190496160 发表于 2024-3-17 09:53

太感谢了，真的好用！

yijijie

我把框美化一点点，写了点注释重新贴出来，有需要的教务老师方便以后使用：

1. Private Sub Worksheet_SelectionChange(ByVal T As Range)
   
2. '这是一个事件处理程序，它会在工作表中选择发生更改时触发。它接受一个参数T，表示选定的范围
   
3. 
   
4. ActiveWindow.Zoom = 100                                      '这行代码将活动窗口的缩放设置为100%
   
5. If T.Row > 4 Then                                            '检查选定的单元格是否在第5行之后,前5行是标题
   
6.     If T.Count > 1 Then End                                  '如果选定的范围包含多个单元格，则终止执行代码
   
7.     r = Cells(Rows.Count, 3).End(xlUp).Row - 14               '确定列C中最后一个非空单元格所在的行，然后减去14。是在计算数据区域的最后一行
   
8.     y = Cells(3, Columns.Count).End(xlToLeft).Column         '这行代码确定行3中最后一个非空单元格所在的列，然后存储该列的列号
   
9.     x = T.Row: w = T.Column                                  '将选定范围的行号和列号分别存储在变量x和w中
   
10.     If x > r Or w > y Then ListBox1.Visible = False: End     '如果选定的范围在数据区域之外，则隐藏名为ListBox1的控件并终止执行代码
    
11.     'MsgBox r                                                 '这行代码会显示一个消息框，其中包含变量r的值。r似乎是计算的数据区域的最后一行
    
12.    
    
13.    '嵌套的循环，用于创建一个字典对象d，其中存储了与选定单元格值不同的相邻单元格的数值数据。它在列中搜索与选定单元格相同的单元格值，并收集相邻单元格中的数值数据。
    
14.    
    
15.     If Not IsNumeric(T.Value) Or T.Value = "" Then End     '***解决点击空白单元格也能弹窗的问题   '这行代码检查选定单元格的值是否为数值类型。如果不是，则立即结束代码的执行。
    
16.     Dim d As Object, dc As Object
    
17.     Set d = CreateObject("scripting.dictionary")
    
18.     Set dc = CreateObject("scripting.dictionary")           '这两行代码创建了两个字典对象，分别用于存储不同的数据
    
19.     bj = Cells(3, w)                                        '这行代码获取行3和列w处的单元格的值，并将其存储在变量bj中
    
20.    
    
21.     xq = Cells(4, w)                                    '****xq为变量，对应点击单元格上方的星期几
    
22.    
    
23.     For j = 3 To y                                          '这是一个循环，从列3开始，直到列y。y是列的最后一个列号
    
24.         If Cells(4, j) = xq Then                        '****循环中加入判断：星期那行有等于变量xq的就继续下面的代码（此段代码限定了下段代码的范围）
    
25.             
    
26.              If Cells(x, j) <> "" Then dc(Cells(x, j).Value) = ""   '这行代码检查当前列中第x行是否为空。如果不为空，它将当前单元格的值作为键存储在字典对象dc中。这一步旨在收集选定行中所有非空单元格的值
    
27.         
    
28.         End If
    
29.     Next j
    
30.     For j = 3 To y                                          '遍历所有列
    
31.         If Cells(3, j) = bj Then                            '检查第3行的当前列是否与之前存储在bj变量中的值相同
    
32.             For i = 6 To r                                  '从第6行到r行。r是之前计算出来的数据区域的最后一行
    
33.                 If i <> x Then
    
34.                     If Cells(i, j) <> "" Then               '在内部循环中，首先检查i行和当前列的单元格是否为空。如果不为空，它将检查这个单元格的值是否与选定单元格的值不同，并且这个值是否为数值类型
    
35.                         If Cells(i, j) <> T.Value Then
    
36.                             If IsNumeric(Cells(i, j)) Then
    
37.                                 If Not dc.exists(Cells(i, j).Value) Then
    
38.                                     d(Cells(i, j).Value) = ""
    
39.                                 End If
    
40.                             End If
    
41.                         End If
    
42.                     End If
    
43.                 End If
    
44.             Next i
    
45.         End If
    
46.     Next j
    
47.     If d.Count = 0 Then End
    
48.     [ar1:cp1] = ""                                      '****清空上次记录，以便下行代码重新记录
    
49.     [ar1].Resize(1, d.Count) = d.keys
    
50.     With ListBox1
    
51.         .Width = T.Width * 1.2                          '****列表框宽度
    
52.         .Height = T.Height * UBound(d.keys) * 0.95         '****列表框高度
    
53.         .Top = T.Top + 15
    
54.         .Left = T.Left + 20
    
55.         .List = d.keys
    
56.         .Visible = True
    
57.     End With
    
58.     End If
    
59. End Sub
    

复制代码