考勤记录整理

Howard7738 · 发表于 2023-12-22 22:18

需求：左侧为考勤打卡记录，打卡次数不固定，为了分别判断上下午迟到、早退和缺席，需要整理成右侧表，请高手指点，非常感谢！
上午工作时间：08:00 - 12:00
下午工作时间：14:00 - 17:30

过客fppt · 发表于 2023-12-22 23:22

为什么星期四的打卡2，14:10放在上午2呢

sjwxsdj · 发表于 2023-12-23 09:58

工号a1，上午下班，打卡两次，下午上班未打卡。

3190496160 · 发表于 2023-12-23 10:10

Sub 考勤整理()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long
Dim br()
With Sheets("sheet1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
y = .Cells(1, Columns.Count).End(xlToLeft).Column
If r < 5 Then MsgBox "导入蔬菜定价工作表为空，请先导入数据！": End
ar = .Range(.Cells(1, 1), .Cells(r, y))
End With
ReDim br(1 To UBound(ar), 1 To 7)
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
      n = n + 1
      br(n, 1) = ar(i, 1)
      br(n, 2) = ar(i, 2)
      br(n, 3) = ar(i, 3)
      zks = "": zjs = "": xks = "": xjs = ""
      For j = 4 To UBound(ar, 2)
         If Trim(ar(i, j)) <> "" Then
            If TimeValue(ar(i, j)) > TimeValue("8:00:00") And TimeValue(ar(i, j)) < TimeValue("9:00:00") Then
                  zks = "上午迟到"
            End If
            If TimeValue(ar(i, j)) > TimeValue("11:00:00") And TimeValue(ar(i, j)) < TimeValue("12:00:00") Then
                  zjs = "上午早退"
            End If
            If TimeValue(ar(i, j)) > TimeValue("14:30:00") And TimeValue(ar(i, j)) < TimeValue("16:00:00") Then
                  xks = "下午迟到"
            End If
            If TimeValue(ar(i, j)) > TimeValue("16:00:00") And TimeValue(ar(i, j)) < TimeValue("17:30:00") Then
                  xjs = "下午早退"
            End If
         End If
      Next j
      br(n, 4) = zks
      br(n, 5) = zjs
      br(n, 6) = xks
      br(n, 7) = xjs
End If
Next i
With Sheets("考勤统计")
.[a1].CurrentRegion.Offset(1).Borders.LineStyle = 0
.[a1].CurrentRegion.Offset(1) = Empty
.[a2].Resize(n, 7) = br
.[a2].Resize(n, 7).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2023-12-23 10:11

仅供参考

考勤整理.rar (20.13 KB, 下载次数: 13)

太极拍天雄 · 发表于 2023-12-23 21:29

纯粹学习+练习而已！

Howard7738 · 发表于 2023-12-24 18:10

非常感谢指点迷津，很受启发！

李桥贵 · 发表于 2024-1-14 11:44

Howard7738 发表于 2023-12-24 18:10
非常感谢指点迷津，很受启发！

自已编写代码处理速度慢，麻烦老师帮一下忙，谢谢。

考勤处理.zip (50.09 KB, 下载次数: 0)

李桥贵 · 发表于 2024-1-14 11:46

3190496160 发表于 2023-12-23 10:10
Sub 考勤整理()
Application.ScreenUpdating = False
Dim ar As Variant

自已编写代码处理速度慢，麻烦老师帮一下忙，谢谢。

考勤处理.zip (50.09 KB, 下载次数: 3)

		自动登录	找回密码
密码			免费注册

[求助] 考勤记录整理

评分