从总课表里列举出每位大佬课程，做成考勤表
求大师帮忙，把这天每位大佬的课程自动填入填入，日期变化，课程也跟着变化，这就做成了考勤表。啥意思了？你模拟个结果 请大师们帮忙看看。 考勤表？还是课程表？
规则是啥？不明白
想要是这样吗？将课程表改变数据格式，把对应的任课大佬添加在课程表里面，一切将变得简单 Sub 考勤表()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant, cr As Variant
Dim i As Long
Dim arr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("人事")
ar = ..CurrentRegion
End With
For i = 3 To UBound(ar)
If Trim(ar(i, 1)) <> "" Then
If IsNumeric(ar(i, 1)) Then
d(ar(i, 1)) = i
End If
End If
Next i
For j = 3 To UBound(ar, 2)
If Trim(ar(2, j)) <> "" Then
zf = Left(Trim(ar(2, j)), 1)
d(zf) = j
End If
Next j
With Sheets("考勤")
r = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("c3:l" & r) = Empty
br = .Range("a2:l" & r)
For i = 2 To UBound(br)
If Trim(br(i, 1)) <> "" Then
dc(Trim(br(i, 1))) = i
End If
Next i
zc = ..Value
Set Rng = Sheets("课表").Rows(2).Find(zc, , , , , , 1)
If Rng Is Nothing Then MsgBox "找不到你设置的周次！": End
ws = Rng.Column
rs = Sheets("课表").Cells(Rows.Count, 1).End(xlUp).Row
cr = Sheets("课表")..CurrentRegion
For i = 4 To UBound(cr)
For j = ws To ws + 7
If Trim(cr(i, j)) <> "" Then
xh = d(cr(i, 1))
lh = d(Trim(cr(i, j)))
If xh <> "" And lh <> "" Then
xx = ar(xh, lh)
m = dc(xx)
If m <> "" Then
hh = cr(3, j) + 2
br(m, hh) = cr(i, 1) & "-" & cr(i, j)
End If
End If
End If
Next j
Next i
.Range("a2:l" & r) = br
End With
MsgBox "ok!"
End Sub Private Sub Worksheet_Change(ByVal T As Range)
If T.Row = 1 And T.Column = 12 Then
If T.Value = "" Then End
Call 考勤表
End If
End Sub 求大师帮忙，把这天每位大佬的课程自动填入填入，日期变化，课程也跟着变化，这就做成了考勤表。比如11月7日石珊珊大佬上午四节课，还有许胜宝大佬下午四节，把所有大佬的课都显示出来
是课程表，对不起，我描述清楚