根据总课程表分别生成班级课程表和教师课程表

qujing342

请教：如何利用公式者VBA,将总课程表拆分成教师课程表和班级课程表

蓝桥玄霜

表2的M2单元格的数据有效性中的括号()改为汉字（）

qujing342

蓝桥**版主，您好，我用您帮助VBA代码，没有实现呢？，中文（）也改了，请帮忙看看是哪里出了问题？
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Target.Address <> "$M$2" Then Exit Sub
Dim hs, Arr, i%, jX, bj$, coL%, ii%
Application.ScreenUpdating = False
Range("d4:i4,d6:i7,d9:ii0,d12:i17,d19:i22").ClearContents
bj = Target.Value: coL = 3
hs = Array(4, 6, 7, 9, 10, 12, 13, 14, 15, 16, 17, 19, 20, 21, 22)
Arr = Sheet1.[a4].CurrentRegion
For i = 4 To UBound(Arr)
      If Arr(i, 9) = bj Then
         For j = 10 To UBound(Arr, 2) Step 15
            coL = coL + 1
            For ii = 0 To UBound(hs)
              Cells(hs(ii), coL) = Arr(i, j + ii)
           Next
      Next
   End If
Next
Application.ScreenUpdating = True
End Sub

qujing342

yynrzwh

1.楼主是要调整冲突教师还是要生成课程表？
2.冲突的教师怎么调整？同行调？同一天内调？6天内调？

这段时间看了很多个排课的帖子了。

3190496160

Sub 班级课表()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
With Sheets("总课表")
    r = .Cells(Rows.Count, 9).End(xlUp).Row
    y = .Cells(1, Columns.Count).End(xlToLeft).Column
    If r < 7 Then MsgBox "总课表为空！": End
    ar = .Range("i4:cu" & r)
End With
rr = Array(1, 3, 4, 6, 7, 9, 10, 11, 12, 13, 14, 16, 17, 18, 19)
With Sheets("班级课表")
   rs = .Cells(Rows.Count, 9).End(xlUp).Row
   If rs > 21 Then .Rows("22:" & rs).Delete
    k = 1
    For i = 4 To UBound(ar)
        Erase br
        ReDim br(1 To 21, 1 To 6)
        y = 0
        If ar(i, 1) <> "" Then
            For j = 2 To UBound(ar, 2) Step 15
                y = y + 1
                m = 0
                For s = j To j + 14
                    If s <= UBound(ar, 2) Then
                        m = m + 1
                        xh = rr(m - 1)
                        br(xh, y) = ar(i, s)
                    End If
                Next s
            Next j
        End If
        If k > 1 Then
            .Rows("1:21").Copy .Cells(k, 1)
        End If
        For s = 0 To UBound(rr)
            x = rr(s) + k + 1
            .Cells(x, 3).Resize(1, 6) = Empty
        Next s
        .Cells(k, 1) = ar(i, 1) & " 班     课     程     表"
        .Cells(k + 2, 3).Resize(UBound(br), UBound(br, 2)) = br
        k = k + 21
    Next i
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

求助：如何用公式或VBA将Sheet1总课程表生成教师课程表和班级课程表.rar (57.41 KB, 下载次数: 28)

2024-8-6 11:31 上传

点击文件名下载附件

3190496160

目前只写了生成班级课表的代码，供参考
一次性生成所有班级课表，然后批量打印即可

wengjl

你的总课程表是用什么工具排出来的？还是手工排的？

jaxxcyh

让学校买个“水晶排课”，好用的很