求助：关于一键自动生成周排课表

zmlaixjl

求助：
       各位大神：
              附件是校方给的开课信息表，根据开课信息表，我们需要生成每周的课表，请求哪位大神用VBA将其实现，万分感谢。
              祝好！

3190496160

上课日期为开课日期+7
这句话如何理解呢？？？？

3190496160

Sub 周排课表()
Dim ar As Variant
Dim br()
Dim i As Long
ar = Sheet1.[a1].CurrentRegion
With ActiveSheet
    ks = .[l1]
    js = .[n1]
    If Not IsDate(ks) Or Not IsDate(js) Then MsgBox "请输入日期": Exit Sub
    For i = UBound(ar) To 2 Step -1
        If Trim(ar(i, 14)) <> "" Then
            xh = i
            Exit For
        End If
    Next i
    If xh = "" Then
        xh = UBound(ar)
    Else
        xh = xh
    End If
    ReDim br(1 To UBound(ar), 1 To 9)
    For i = 2 To xh
        If IsDate(ar(i, 6)) Then
            rq = ar(i, 6) + 7
            If DateValue(rq) >= DateValue(ks) And DateValue(rq) <= DateValue(js) Then
                n = n + 1
                For j = 2 To 10
                    If j <> 6 Then
                        br(n, j - 1) = ar(i, j)
                    End If
                Next j
                br(n, 5) = rq
            End If
        End If
    Next i
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(n, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub

3190496160

代码是猜呢，仅供参考
排课表.rar (25.08 KB, 下载次数: 37)

2021-1-29 16:45 上传

点击文件名下载附件

zmlaixjl

3190496160 发表于 2021-1-29 16:45
代码是猜呢，仅供参考

多谢大神，只要是在结课日期前的课程，每周同一时间仍然需要排课，比如1月9日的周六的课，没有结课，在2.1日-2.7日这周还是有的。

3190496160

zmlaixjl 发表于 2021-1-31 16:54
多谢大神，只要是在结课日期前的课程，每周同一时间仍然需要排课，比如1月9日的周六的课，没有结课，在2. ...

不明白你在说什么

yellowhawk

排课表是大工程！这个如果有人搞个Excel排课表系统就方便教务人员了！