|
|
Sub 考勤统计()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
With Sheets("员工刷卡记录表")
y = .Cells(6, Columns.Count).End(xlToLeft).Column
x = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range(.Cells(1, 1), .Cells(x, y))
Set Rng = .Range(.Cells(6, 1), .Cells(6, y))
End With
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2) + 3)
With Sheets("考勤统计")
.[a1].CurrentRegion = Empty
.[a2].Resize(1, 3) = Array("序号", "姓名", "部门")
Rng.Copy .[d2]
For i = 5 To UBound(ar) Step 3
If Trim(ar(i, 1)) <> "" Then
n = n + 1
br(n, 1) = n
br(n, 2) = Split(ar(i, 9), ":")(1)
br(n, 3) = Split(ar(i, 17), ":")(1)
For j = 1 To UBound(ar, 2)
If Trim(ar(i + 2, j)) = "" Then
br(n, j + 3) = "漏打"
Else
sl = Len(Trim(ar(i + 2, j)))
If sl <= 5 Then
fm_1 = ar(i + 2, j)
If TimeValue(fm_1) > TimeValue("08:30") And TimeValue(fm_1) < TimeValue("09:00") Then
br(n, j + 3) = "迟到"
ElseIf TimeValue(fm_1) > TimeValue("12:00") And TimeValue(fm_1) < TimeValue("17:30") Then
br(n, j + 3) = "早退"
End If
ElseIf sl > 5 Then
For ii = 1 To sl Step 5
fm_1 = ""
For s = ii To ii + 4
fm_1 = fm_1 & Mid(Trim(ar(i + 2, j)), s, 1)
Next s
If IsDate(fm_1) Then
If TimeValue(fm_1) > TimeValue("08:30") And TimeValue(fm_1) < TimeValue("09:00") Then
br(n, j + 3) = "迟到"
ElseIf TimeValue(fm_1) > TimeValue("12:00") And TimeValue(fm_1) < TimeValue("17:30") Then
br(n, j + 3) = "早退"
End If
End If
Next ii
End If
End If
Next j
End If
Next i
.[a3].Resize(n, UBound(br, 2)) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2021-5-27 15:46
楼主
