计算加班时间

sulli112

计算加班时间段：
1.当天最后一个打卡时间—早上8:00-8个小时-1个小时，算出加班时间（适用于周一到周五）2.EXCEL表中标黄色的为周末，希望可以自动判断出是否为周末，如果当天为周末计算公式跟公式1中一致但是计算出的时间段需要乘以2

3190496160

Sub 考勤统计()
Dim d As Object
Dim ar As Variant
Dim i As Long
Dim br()
Set d = CreateObject("scripting.dictionary")
With Sheets("考勤")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("i2:j" & r) = Empty
    ar = .[a1].CurrentRegion
    ReDim br(1 To UBound(ar), 1 To 6)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 2)) <> "" And Trim(ar(i, 4)) <> "" Then
           rq = CDate(Format(ar(i, 4), "yyyy/mm/dd"))
           zf = Trim(ar(i, 2)) & "|" & rq
           t = d(zf)
           If t = "" Then
                k = k + 1
                d(zf) = k
                t = k
                For j = 1 To 3
                    br(k, j) = ar(i, j)
                Next j
                br(k, 4) = rq
                br(k, 5) = Weekday(rq, 2)
            End If
            sf = CDate(Format(ar(i, 4), "h:mm:ss"))
            If br(t, 5) < 6 Then
                br(t, 6) = Hour(sf) - Hour("8:00:00") - 1
            Else
                br(t, 6) = (Hour(sf) - Hour("8:00:00") - 1) * 2
            End If
        End If
    Next i
End With
With Sheets("统计考勤")
     .[a1].CurrentRegion.Offset(1) = Empty
     .[a2].Resize(k, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub

3190496160

考勤.rar (17.51 KB, 下载次数: 19)

2021-7-30 10:01 上传

点击文件名下载附件

3190496160

没有考虑分钟问题，只是计算小时数，供参考

sulli112

3190496160 发表于 2021-7-30 10:02
没有考虑分钟问题，只是计算小时数，供参考

如果我还考虑0.5小时，请问要怎么修改了，因为我测算了一下如果早上8点上班，下午5点30下班，中间休息1个小时，一天应该有8.5小时，15分钟-30分钟内按0.5小时计算，40分钟-60分钟按1小时计算

3190496160

sulli112 发表于 2021-7-30 13:51
如果我还考虑0.5小时，请问要怎么修改了，因为我测算了一下如果早上8点上班，下午5点30下班，中间休息1个 ...

早知道你会这么准问的，这样的话，就不简单了，耐心等待吧，

3190496160

Sub 考勤统计()
Dim d As Object
Dim ar As Variant
Dim i As Long
Dim br()
Set d = CreateObject("scripting.dictionary")
With Sheets("考勤")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("i2:j" & r) = Empty
    ar = .[a1].CurrentRegion
    ReDim br(1 To UBound(ar), 1 To 6)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 2)) <> "" And Trim(ar(i, 4)) <> "" Then
           rq = CDate(Format(ar(i, 4), "yyyy/mm/dd"))
           zf = Trim(ar(i, 2)) & "|" & rq
           t = d(zf)
           If t = "" Then
                k = k + 1
                d(zf) = k
                t = k
                For j = 1 To 3
                    br(k, j) = ar(i, j)
                Next j
                br(k, 4) = rq
                br(k, 5) = Weekday(rq, 2)
            End If
            sf = CDate(Format(ar(i, 4), "h:mm:ss"))
            fz = Minute(sf)
            If fz < 15 Then
                js = 0
            ElseIf fz >= 15 And fz <= 30 Then
                js = 0.5
            ElseIf fz > 30 Then
                js = 1
            End If
            If br(t, 5) < 6 Then
                br(t, 6) = Hour(sf) - Hour("8:00:00") - 1 + js
            Else
                br(t, 6) = (Hour(sf) - Hour("8:00:00") - 1 + js) * 2
            End If
        End If
    Next i
End With
With Sheets("统计考勤")
     .[a1].CurrentRegion.Offset(1) = Empty
     .[a2].Resize(k, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub

3190496160

考勤.rar (17.39 KB, 下载次数: 25)

2021-7-30 15:30 上传

点击文件名下载附件

65861954

3190496160 发表于 2021-7-30 15:30

大神啊，学习中

sulli112

3190496160 发表于 2021-7-30 15:30

我查看了一下，假如打卡时间多3分钟的话，直接为0.5H,请问这个0.5H可以设定范围吗？15-30分钟内才四舍五入为0.5H？谢谢，如果不可以设定那就打扰啦