如何列出整个学校在某节课没有课的老师

定敏

因为学校经常有教师出差，而他所任教的课得找人代课，如何从全校教师名单中列出某一节课有哪些老师没有课，好方便安排他代课。如图：全校有14位专任教师（在后面的表），而只有八个班级，所以每节课都有六位教师是空着的，如何用公式或VBA排出这没有课的六位教师，谢谢：



排课.rar (12.78 KB, 下载次数: 22)

2021-10-18 17:13 上传

点击文件名下载附件

zpy2

这种总课表的格式，搞起来强度太大。。。

定敏

zpy2 发表于 2021-10-18 18:08
这种总课表的格式，搞起来强度太大。。。

确实强度大，可不可以只搞一节课的来示范下，谢谢。

zpy2

定敏 发表于 2021-10-18 18:10
确实强度大，可不可以只搞一节课的来示范下，谢谢。

https://club.excelhome.net/forum.php?mod=viewthread&tid=1597588&extra=&mobile=2&_dsign=43e374b4
建议 总课程表 转换成 一维表 ，消除合并单元格，再计算

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("总课表").UsedRange
    brr = [a1:f4]
    crr = [h1:h15]
    For i = 2 To 4
        d.RemoveAll
        For j = 3 To UBound(arr, 2)
            If Len(arr(2, j)) > 0 Then str1 = arr(2, j)
            d(str1 & arr(i * 2 + 3, j)) = ""
        Next j
        For j = 2 To UBound(brr, 2)
            str1 = ""
            For k = 2 To UBound(crr)
                If Not d.exists(brr(1, j) & crr(k, 1)) Then str1 = str1 & "," & crr(k, 1)
            Next k
            brr(i, j) = Mid(str1, 2)
        Next j
    Next
    [a1:f4] = brr
End Sub

liulang0808

附件内容供参考。。。。。。

lisongmei

仅供参考

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("总课表")
   
7.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
8.     c = .Cells(5, .Columns.Count).End(xlToLeft).Column
   
9.     arr = .Range("a2").Resize(r - 1, c)
   
10.   End With
    
11.   For j = 3 To UBound(arr, 2)
    
12.     If Len(arr(1, j)) <> 0 Then
    
13.       xq = arr(1, j)
    
14.     End If
    
15.     For i = 5 To UBound(arr) Step 2
    
16.       xm = arr(i, 2) & "+" & xq
    
17.       If Len(arr(i + 1, j)) <> 0 Then
    
18.         If Not d.exists(xm) Then
    
19.           Set d(xm) = CreateObject("scripting.dictionary")
    
20.         End If
    
21.         d(xm)(arr(i + 1, j)) = Empty
    
22.       End If
    
23.     Next
    
24.   Next
    
25.   With Worksheets("备选人")
    
26.     r = .Cells(.Rows.Count, 9).End(xlUp).Row
    
27.     brr = .Range("i3:i" & r)
    
28.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
29.     .Range("c3:g" & r).ClearContents
    
30.     arr = .Range("b2:g" & r)
    
31.     For i = 2 To UBound(arr)
    
32.       kj = "第" & Application.Text(Val(Mid(arr(i, 1), 2)), "[DBNum1]") & "节"
    
33.       For j = 2 To UBound(arr, 2)
    
34.         xm = kj & "+" & arr(1, j)
    
35.         If d.exists(xm) Then
    
36.           For k = 1 To UBound(brr)
    
37.             If Not d(xm).exists(brr(k, 1)) Then
    
38.               arr(i, j) = arr(i, j) & "," & brr(k, 1)
    
39.             End If
    
40.           Next
    
41.         End If
    
42.       Next
    
43.     Next
    
44.     For i = 2 To UBound(arr)
    
45.       For j = 2 To UBound(arr, 2)
    
46.         If Len(arr(i, j)) <> 0 Then
    
47.           arr(i, j) = Mid(arr(i, j), 2)
    
48.         End If
    
49.       Next
    
50.     Next
    
51.     .Range("b2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
52.   End With
    
53. End Sub
    

复制代码

chxw68

详见附件。

yanjie

老师排课_数据透视表20211018.rar (42.21 KB, 下载次数: 9)

2021-10-18 22:51 上传

点击文件名下载附件

用数据透视表做的，星期一到星期五共5个工作表显示的没有课的老师，PT工作表显示的是有课的8个老师，切换页字段，自动显示上课老师，标注红旗的，如图：