|
- Sub 个人课程表()
- arr = Sheet1.Range("a1:bh43")
- Dim brr(1 To 8, 1 To 5)
- With Sheet2
- For n = 1 To 2
- If n = 1 Then js = .[d2] Else js = .[d15] '老师
- For i = 4 To UBound(arr)
- c = Int((i + 4.1) / 8) '行数对应Brr列(星期)
- r = arr(i, 2) '每天课数对应brr行
- For j = 4 To UBound(arr, 2) Step 2
- If arr(i, j) = js Then brr(r, c) = arr(3, j - 1) & "/" & arr(i, j - 1)
- Next
- Next
- If n = 1 Then .[b5].Resize(8, 5) = brr Else .[b17].Resize(8, 5) = brr
- Erase brr
- Next
- End With
-
- End Sub
- Sub 班级课程表()
- arr = Sheet1.Range("a1:bh43")
- Dim brr(1 To 8, 1 To 5)
- With Sheet3
- For n = 1 To 2
- If n = 1 Then xbj = .[d2] Else xbj = .[d14] '老师
- Set xrng = Sheet1.Rows(3).Find(xbj, lookat:=xlWhole)
- If xrng Is Nothing Then Exit Sub
- j = xrng.Column
- For i = 4 To UBound(arr)
- c = Int((i + 4.1) / 8) '行数对应Brr列(星期)
- r = arr(i, 2) '每天课数对应brr行
- If arr(i, j + 1) = "" Then brr(r, c) = arr(i, j) Else brr(r, c) = arr(i, j + 1) & "/" & arr(i, j)
- Next
- If n = 1 Then .[b4].Resize(8, 5) = brr Else .[b16].Resize(8, 5) = brr
- Erase brr
- Next
- End With
- End Sub
复制代码 |
评分
-
查看全部评分
|