这种调课要求不知道VBA能不能实现，求帮忙

jx928867128

本贴继续求各位帮忙，请各位好心人注意附件的问题说明中的第二个要求

jx928867128

问题没解决，继续求帮忙。

3190496160

3190496160

每天课程节数不同的问题，增加了一句代码，修改了两句代码，
自己根据图片修改代码，自己测试看看吧，没有相应的表格测试，自己测试看看

jx928867128

3190496160 发表于 2024-4-6 09:23
每天课程节数不同的问题，增加了一句代码，修改了两句代码，
自己根据图片修改代码，自己测试看看吧，没有 ...

万分感谢朱老师的再次帮忙，感恩您的多次无私付出，祝您生活愉快，好人一生平安。

jx928867128

3190496160 发表于 2024-4-6 09:22

调课模式(修改代码后不能运行).rar (170.07 KB, 下载次数: 12)

2024-4-6 11:44 上传

点击文件名下载附件

老师好，我把代码修改后程序为什么运行不起来，方便帮我看看哪里改错了吗

jx928867128

3190496160 发表于 2024-4-6 09:23
每天课程节数不同的问题，增加了一句代码，修改了两句代码，
自己根据图片修改代码，自己测试看看吧，没有 ...

老师好，估计是我没有表达清楚，不是每天课程节数不同，每次排课是每天课程节数都相同，只是可能和上一次排课的课程节数不同（比如上一次每天全部是13节，这次排课每天全部是10节课）

3190496160

课表设计随心所欲，再高明的代码也是难以完全适应的

jx928867128

3190496160 发表于 2024-4-6 18:53
课表设计随心所欲，再高明的代码也是难以完全适应的

老师说得对，学校排课软件换了好几套，就是因为学校的课表结构时时变，没有哪一款软件可以搞定，只能手工搞，没办法才到来论坛里求各位帮忙，2楼的代码经测试是可以满足学校课表结构变化，就是课示显示没有网格线，查看节次很吃力，如果能加个网格线就很完美了。

jx928867128

3190496160 发表于 2024-4-5 10:56
Private Sub UserForm_Initialize()
Dim ar As Variant
Dim br()

Private Sub UserForm_Initialize()
Dim ar As Variant
Dim br()
rr = Array("节次", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六", "星期日")
With Sheets("汇总")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    y = .Cells(4, Columns.Count).End(xlToLeft).Column
    ar = .Range(.Cells(1, 1), .Cells(r, y))
    For j = 0 To UBound(rr)
        ListView1.ColumnHeaders.Add , , rr(j), 90 'Sheets("物料库存数据").Cells(3, j).Width
    Next
    ListView1.View = lvwReport
    ListView1.FullRowSelect = True
    ListView1.Gridlines = True
    ReDim br(1 To 14, 1 To 8) '14是课表最后一节所在的列号，如果节次有变化就修改这个值。
    br(1, 1) = "节次"
    For j = 2 To 14 '14是课表课表最后一节所在的列号，如果节次有变化就修改这个值。
        br(j, 1) = ar(4, j)
    Next j
    zd = ActiveCell.Value
    xm = Split(zd, Chr(10))(1)
    y = 1
    For j = 2 To UBound(ar, 2) Step 13
        y = y + 1
        For s = j To j + 12 '12是正课与晚自习的总节数，如果节数有变化就修改这个值。
            If IsNumeric(ar(4, s)) Then
                xh = ar(4, s) + 2
            ElseIf ar(4, s) = "早读" Then
                xh = 2
            ElseIf InStr(ar(4, s), "晚") > 0 Then
                xh = Right(ar(4, s), 1) + 11 '11是晚自习第一节的位置列号，如果有变化就修改这个值。
            End If
            For i = 5 To UBound(ar)
                If ar(i, s) <> "" Then
                    If InStr(ar(i, s), Chr(10)) > 0 Then
                        If InStr(ar(i, s), xm) > 0 Then
                            br(xh, y) = Split(ar(i, s), Chr(10))(0) & ar(i, 1)
                        End If
                    End If
                End If
            Next i
        Next s
    Next j
    For i = 2 To UBound(br)
        Set Itm = ListView1.ListItems.Add
        Itm.text = br(i, 1)
        For j = 2 To UBound(br, 2)
            Itm.SubItems(j - 1) = br(i, j)
        Next j
   Next i
End With
End Sub
老师好，您的代码我这样理解对吗，如果正确的话，我以后只要直接修改参数就行了