考勤计算的相关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

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

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

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