从总课表里列举出每位大佬课程，做成考勤表

信行致远 · 2021-12-28 05:23:25

请大师们帮忙看看。

全龙 · 2021-12-28 09:45:54

考勤表？还是课程表？
规则是啥？不明白

在理 · 2021-12-29 11:11:28

谢安鲁 · 2021-12-29 16:40:25

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 = .[a1].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 = .[b1].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("课表").[a1].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

夏末染殇 · 2021-12-31 16:52:00

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

猫眼看球 · 2022-1-2 07:55:51

从课表里生成考勤表.rar (44.52 KB, 下载次数: 15)

吉祥高照 · 2022-1-3 03:03:37

求大师帮忙，把这天每位大佬的课程自动填入填入，日期变化，课程也跟着变化，这就做成了考勤表。比如11月7日石珊珊大佬上午四节课，还有许胜宝大佬下午四节，把所有大佬的课都显示出来

从课表里生成考勤表.zip (34.03 KB, 下载次数: 14)

有趣的灵魂三百斤 · 2022-1-8 21:03:58

是课程表，对不起，我描述清楚

袁平 · 2022-1-11 02:55:00

考勤表？还是课程表？
规则是啥？不明白

领队李楠 · 2022-1-20 00:48:55

从课表里生成考勤表.zip (84.29 KB, 下载次数: 13)

		自动登录	找回密码
密码			立即注册