考勤计算的相关VBA代码


通过考勤机进行考勤后,可能出现每天几次打卡的情况,尤其是制造型的企业,有时打卡四次,有时打卡六次,甚至更多,但考勤机的数据只会记录相关的打卡记录,且记录的格式为:"aa:bb",即多少点,多少分打卡,如何用VBA代码快速进行数据拆解,并核算相关工时呢?

具体操作步骤如下:

第一步:清洗数据

也就是对打卡数据的完整性进行清洗,为什么要进行清洗呢,因为,考勤系统只是做了一个笼统的记录,可能存在员工在同一时间多次打卡的情况,也可能存在员工漏打卡的情况,要针对这些情况进行一些区分,把同一时间多次打卡的的记录删除掉,按排班时间将打卡记录进行有序拆分。

具体拆分代码如下所示:

Range("F2:K9999").ClearContents '清除前次数据,一般用于测试
Dim K, i, j, m, ys
For i = 2 To [e65536].End(xlUp).Row
    m = 6
    K = Split(Cells(i, 5), " ")
  
    For j = 0 To UBound(K)
    ys = UBound(K) Mod 2  '这里重点考虑打卡次数,如果被2整除,那么数据基本齐整
    '当K被2整除时
        If ys <> 0 Then
            Cells(i, m).Value = Format(K(j), "hh:mm")
            m = m + 1
        End If
    '当K不被2整除时
        If ys = 0 Then
            If j >= 1 Then
                If Abs(DateDiff("n", TimeValue(K(j)), TimeValue(K(j - 1)))) > 5 Then '当大于5分钟时,删除一个数字
                    If TimeValue(K(j)) > TimeValue("11:30") And TimeValue(K(j)) < TimeValue("12:25") Then '第一次下班
                        Cells(i, 7).Value = Format(K(j), "hh:mm")'表格第七列记录第一次下班
                        m = m + 1
                    End If
                    
                    If TimeValue(K(j)) > TimeValue("13:15") And TimeValue(K(j)) < TimeValue("13:40") Then '第二次上班
                        Cells(i, 8).Value = Format(K(j), "hh:mm")'表格第八列记录第二次上班
                        m = m + 1
                    End If
                    
                    If TimeValue(K(j)) > TimeValue("17:10") And TimeValue(K(j)) < TimeValue("17:35") Then '第二次下班
                        Cells(i, 9).Value = Format(K(j), "hh:mm")'表格第9列记录第二次下班
                        m = m + 1
                    End If
                    
                    If TimeValue(K(j)) > TimeValue("17:45") And TimeValue(K(j)) < TimeValue("18:01") Then '第三次上班
                        Cells(i, 10).Value = Format(K(j), "hh:mm")
                        m = m + 1
                    End If
                    
                    If TimeValue(K(j)) > TimeValue("19:00") And TimeValue(K(j)) < TimeValue("23:50") Then '第三次下班
                        Cells(i, 11).Value = Format(K(j), "hh:mm")
                        m = m + 1
                    End If
                End If
            Else
                Cells(i, m).Value = Format(K(j), "hh:mm")
                m = m + 1
            End If
        End If
    Next
Next

提醒,上述代码执行完成后,可能还需要人为进行检查,因为打卡的情况实在太复杂,有时几个判断还是无法完全涵盖所有情况。

在上述代码中,主要用到的函数如下:

1、Split函数,主要对打卡记录进行有序拆分,一般情况下考勤系统导出的打卡记录在数据表中某列显示为:“07:31 12:01 13:28 17:30 17:57 22:03”

2、timevalue时间函数,主要功能是将字符串转化为标准时间的函数,转化后的标准时间函数可以加减,计算上班的时间长度,具体计算方式如下:

Abs(DateDiff("n", 时间a,时间b)),该函数实现了两个时间相差的多少分钟的计算,如果要计算两个时间相差多少小时,可以将“n"替换成”h“。

第二步,计算工时

当我们完成了打卡记录的拆分,并进行了一一验证后,就可以开始进行工时计算,在计算工时时需要注意正班时间,延时加班,周末加入,甚至还法定假日加班时间计算。

以笔者曾经计算的一个案子为例,计算代码如下:

Range("N2:Z9999").ClearContents'这是工时记录的所在数据区域
Dim Ab, Pb, Lb
For i = 2 To [a65536].End(xlUp).Row
    If Cells(i, 6) <> "" Or Cells(i, 6) <> "" Then'上午上班时间
        Ab = 0.5
    Else
        Ab = 0
    End If
    
    If Cells(i, 8) <> "" Or Cells(i, 8) <> "" Then'下午上班时间
        Pb = 0.5
    Else
        Pb = 0
    End If
    
    If Cells(i, 10) <> "" And Cells(i, 11) <> "" Then'延时加班时间
        Lb = Round(Abs(DateDiff("n", TimeValue(Cells(i, 10)), TimeValue(Cells(i, 11)))) / 30, 0) / 2
    Else
        Lb = 0
    End If
    '判断是不是周末
    If Weekday(Cells(i, 4), vbMonday) <= 5 Then'判断当前时间为周几
        Cells(i, 15) = Ab + Pb
        If Lb > 0 Then
            Cells(i, 16) = Lb
        End If
    Else
        If (Ab + Pb) * 8 + Lb > 0 Then
            Cells(i, 17) = (Ab + Pb) * 8 + Lb
        End If
    End If
Next

上述代码需要区分每个单元格的值,正班按天计算,加班按小时计算。其实里面主要用了一个判断当前时间是周几的函数。

通过上述两个步骤,再对数据一一核对,相信工作量已经大为减少了。

智帮咨询做薪酬辅导,既有高度,更有广度和深度,欢迎小伙们交流沟通。