总课程表提取教师个人课程表

lfy123456

我需要从学校的课程总表里面把教师的个人课程表单独提取出来，每位教师的单独作为一行显示，教师姓名下方能自动把所有教师的姓名提取出来， 后面对应如周一早自习是哪个班的（班级加课程），

良良

新建空白工作表，勾选公式选项卡下的计算选项：手动。然后打开附件，否则会很卡。

3190496160

这种问题，用vba来完成时最佳方案。

gwjkkkkk

VBa 法，请参考。。。

3190496160

Sub 生成教师课表()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 7 Then MsgBox "请在【基本信息设置】中设置年级名称，班级数和开始班级名称！": End
    ar = .Range("a2:bd" & r)
End With
Dim br()
ReDim br(1 To 5000, 1 To UBound(ar, 2))
For j = 1 To UBound(ar, 2)
    br(1, j) = ar(1, j)
    br(2, j) = ar(2, j)
Next j
k = 2
For i = 3 To UBound(ar)
    For j = 2 To UBound(ar, 2)
        If Trim(ar(i, j)) <> "" Then
            rr = Split(ar(i, j), Chr(10))
            zd = rr(1)
            t = d(zd)
            If t = "" Then
                k = k + 1
                d(zd) = k
                t = k
                br(k, 1) = zd
            End If
            br(t, j) = rr(0)
        End If
    Next j
Next i
With Sheet2
    .UsedRange.Clear
    .[a1].Resize(k, UBound(br, 2)) = br
    .[a1].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
    .[a2] = "教师姓名"
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

教师课程表单独拆分.rar (25.22 KB, 下载次数: 38)

2023-7-23 10:52 上传

点击文件名下载附件

3190496160

题外话：
我在单位也是负责课程安排的，似乎楼主这样生成教师课表，没啥意义吧

lfy123456

3190496160 发表于 2023-7-23 10:53
题外话：
我在单位也是负责课程安排的，似乎楼主这样生成教师课表，没啥意义吧

笨人有笨人的办法啊， 我生成这样的课程表之后就可以发布一个查询码， 教师就能够查到自己的课程表

lfy123456

良良 发表于 2023-7-22 11:57
新建空白工作表，勾选公式选项卡下的计算选项：手动。然后打开附件，否则会很卡。

感谢感谢大神的支持