在总课表中如何通过点击生成可以代课老师的名单？

yijijie

在总课表中如何通过点击生成可以代课老师的名单？
先发附件 2024年春课程表原.rar (66.79 KB, 下载次数: 13)

2024-3-16 16:26 上传

点击文件名下载附件

（在这里先感谢大师：EH侠圣  ，他提供了一个可以行的VBA代码，但是有一点点小不足，希望哪位大师接力一下）
需求：每个数字编号代表一位老师，对应关系在30、31行，现在的问题是希望通过点击课程下方的编号，显示可以用于代课的教师编号列表（同一天的相同节次不能跟选中的老师课程冲突）

例如：选中AD8单元格，可以用于本班代课的教师编号有：30、3、37、28、25(他也是本班任课老师)、33

说明：可以代课的老师要任本班的课，也就是在当天或者其他天也有这个班的课，而所在的这一天的这个节次又没有课。

附上EH侠圣大师的代码和我写的粗浅的说明：

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) 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.     For j = 3 To y                                          '这是一个循环，从列3开始，直到列y。y是列的最后一个列号
    
21.         If Cells(x, j) <> "" Then dc(Cells(x, j).Value) = ""   '这行代码检查当前列中第x行是否为空。如果不为空，它将当前单元格的值作为键存储在字典对象dc中。这一步旨在收集选定行中所有非空单元格的值
    
22.     Next j
    
23.     For j = 3 To y                                          '遍历所有列
    
24.         If Cells(3, j) = bj Then                            '检查第3行的当前列是否与之前存储在bj变量中的值相同
    
25.             For i = 6 To r                                  '从第6行到r行。r是之前计算出来的数据区域的最后一行
    
26.                 If i <> x Then
    
27.                     If Cells(i, j) <> "" Then               '在内部循环中，首先检查i行和当前列的单元格是否为空。如果不为空，它将检查这个单元格的值是否与选定单元格的值不同，并且这个值是否为数值类型
    
28.                         If Cells(i, j) <> T.Value Then
    
29.                             If IsNumeric(Cells(i, j)) Then
    
30.                                 If Not dc.exists(Cells(i, j).Value) Then
    
31.                                     d(Cells(i, j).Value) = ""
    
32.                                 End If
    
33.                             End If
    
34.                         End If
    
35.                     End If
    
36.                 End If
    
37.             Next i
    
38.         End If
    
39.     Next j
    
40.     If d.Count = 0 Then End
    
41.     [ar1].Resize(1, d.Count) = d.keys
    
42.     With ListBox1
    
43.         .Visible = True
    
44.         .Width = 30
    
45.         .Top = T.Top + 15
    
46.         .Left = T.Left + 20
    
47.         .List = d.keys
    
48.     End With
    
49.     End If
    
50. End Sub

复制代码

不足之处求完善：候选框里面的老师编号是星期一至星期五该节课均不出现的才显示出来，而我们实际情况是只要被点击的这一天这个节次没有课就可以安排。
如图所示，25号老师请假，其实1、22、33号老师也是可以安排的，不会受到星期四的课时的影响。

ykcbf1100

让原代码老师改比较容易。