如何将年级总课表分解为班课表

fylsg80

如题:如何将年级总课表分解为班课表，请各位师傅帮一下，谢谢！

yynrzwh

fylsg80

yynrzwh 发表于 2024-11-12 21:12

能发一个附件吗？谢谢

qline302

希望能帮到你.

fylsg80

qline302 发表于 2024-11-12 22:13
希望能帮到你.

非常感谢！

excel玉米

yynrzwh 发表于 2024-11-12 21:12

字典嵌套用的溜啊

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim ws As Worksheet
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     For Each ws In Worksheets
   
8.         If ws.Name <> "2026届课表" And ws.Name <> "分班课表" Then
   
9.             ws.Delete
   
10.         End If
    
11.     Next
    
12.     With Worksheets("2026届课表")
    
13.         r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
14.         c = .Cells(2, .Columns.Count).End(xlToLeft).Column
    
15.         arr = .Range("a2").Resize(r - 1, c)
    
16.     End With
    
17.     For j = 3 To UBound(arr, 2)
    
18.         Worksheets("分班课表").Copy after:=Worksheets(Worksheets.Count)
    
19.         ReDim brr(1 To 10, 1 To 5)
    
20.         With ActiveSheet
    
21.             .Name = arr(1, j)
    
22.             For i = 2 To UBound(arr)
    
23.                 If Len(arr(i, 1)) <> 0 Then
    
24.                     n = InStr("一二三四五", Right(arr(i, 1), 1))
    
25.                 End If
    
26.                 m = InStr("一二三四五六七八九", Mid(arr(i, 2), 2, 1))
    
27.                 If m > 5 Then
    
28.                     m = m + 1
    
29.                 End If
    
30.                 brr(m, n) = arr(i, j)
    
31.             Next
    
32.             .Range("c7").Resize(UBound(brr), UBound(brr, 2)) = brr
    
33.         End With
    
34.     Next
    
35. End Sub
    

复制代码

chxw68

练习。。。

yynrzwh

excel玉米 发表于 2024-11-12 23:56
字典嵌套用的溜啊

usedrange

参与学习。。。。