[已解决]完善课表的提取

yangfx163

编号为1的老师，同时在两个班上课，结果只显示一个班的，问如何解决？谢谢

最佳答案

月排行榜 / 总排行榜

grf1973

2016-3-23 11:38

1. Sub 个人课程表()
   
2.     arr = Sheet1.Range("a1:bh43")
   
3.     Dim brr(1 To 8, 1 To 5)
   
4.     With Sheet2
   
5.         For n = 1 To 2
   
6.             If n = 1 Then js = .[d2] Else js = .[d15] '老师
   
7.             For i = 4 To UBound(arr)
   
8.                 c = Int((i + 4.1) / 8)       '行数对应Brr列（星期）
   
9.                 r = arr(i, 2)   '每天课数对应brr行
   
10.                 For j = 4 To UBound(arr, 2) Step 2
    
11.                     If arr(i, j) = js Then brr(r, c) = brr(r, c) & Chr(10) & arr(3, j - 1) & "/" & arr(i, j - 1)
    
12.                 Next
    
13.                 brr(r, c) = Mid(brr(r, c), 2)
    
14.             Next
    
15.             If n = 1 Then .[b5].Resize(8, 5) = brr Else .[b17].Resize(8, 5) = brr
    
16.             Erase brr
    
17.         Next
    
18.     End With
    
19. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 个人课程表()
   
2.     arr = Sheet1.Range("a1:bh43")
   
3.     Dim brr(1 To 8, 1 To 5)
   
4.     With Sheet2
   
5.         For n = 1 To 2
   
6.             If n = 1 Then js = .[d2] Else js = .[d15] '老师
   
7.             For i = 4 To UBound(arr)
   
8.                 c = Int((i + 4.1) / 8)       '行数对应Brr列（星期）
   
9.                 r = arr(i, 2)   '每天课数对应brr行
   
10.                 For j = 4 To UBound(arr, 2) Step 2
    
11.                     If arr(i, j) = js Then brr(r, c) = brr(r, c) & Chr(10) & arr(3, j - 1) & "/" & arr(i, j - 1)
    
12.                 Next
    
13.                 brr(r, c) = Mid(brr(r, c), 2)
    
14.             Next
    
15.             If n = 1 Then .[b5].Resize(8, 5) = brr Else .[b17].Resize(8, 5) = brr
    
16.             Erase brr
    
17.         Next
    
18.     End With
    
19. End Sub
    

复制代码

grf1973

请看附件。