Excel·VBA考勤打卡记录整理

看到一个帖子《excel吧-考勤一天四次打卡，快速找出缺卡》，每个人每天有4次打卡记录，需要整理出所有缺少的打卡记录

与之前的文章《Excel·VBA考勤打卡记录统计结果》结果形式类似
与之前的文章《Excel·VBA考勤打卡记录数据整理》查找上下班打卡时间的要求类似，可以使用其SEARCH_NUM函数（本文代码有修改）

• 时间数组查找函数

Function SEARCH_NUM(ByVal arr, ByVal target, Optional mode$ = "-")
    '函数定义SEARCH_NUM(数组，目标值，查找模式)按指定查找模式查找数组，返回最接近的值
    '3种查找模式，"+"即大于等于、"-"即小于等于、"="即绝对值
    '支持数字格式的数字数组，也支持字符串格式的数字数组
    Dim result, a
    result = none
    For Each a In arr
        a = CDbl(Format(a, "0.0000000000"))  '字符串转为Double格式
        If a = target Then
            SEARCH_NUM = a: Exit Function
        ElseIf mode = "+" And a > target Then
            If result = Empty Or result > a Then result = a
        ElseIf mode = "-" And a < target Then
            If result = Empty Or result < a Then result = a
        ElseIf mode = "=" Then
            If result = Empty Or (Abs(result - target) > Abs(a - target)) Then result = a
        End If
    Next
    SEARCH_NUM = result
End Function

1，仅判断缺少打卡记录

sf参数确定打卡时间范围，超出范围的，就算未打卡
mrr数组参数用于查找方式为，早于上班时间且最晚、晚于下班时间且最早的时间

Sub 考勤整理1()
    'sf时间范围，确定打卡时间归属哪个范围，1/24即前后各1小时
    Dim trr, mrr, arr, ignore_empty As Boolean, only_once As Boolean, start_r&, start_c&, delimiter$
    Dim sf#, i&, j&, t&, srr, s, temp$
'--------------------参数填写：标准上下班时间，对应查找模式；ignore_empty忽略空值；开始行列号；分隔符
    trr = Array(#8:00:00 AM#, #12:00:00 PM#, #1:00:00 PM#, #5:30:00 PM#)
    mrr = Array("-", "+", "-", "+")
'--------------------参数填写：ignore_empty忽略空值；sf时间范围；开始行列号；分隔符
    ignore_empty = True: sf = 1 / 24: start_r = 2: start_c = 2: delimiter = Chr(10)
    arr = Worksheets("考勤").[a1].CurrentRegion.Value: tm = Timer
    For i = start_r To UBound(arr)
        For j = start_c To UBound(arr, 2)
            If Not (Len(arr(i, j)) = 0 And ignore_empty) Then  '非空且忽略空值
                srr = Split(arr(i, j), delimiter)
                For t = 0 To UBound(trr)
                    s = Empty: s = SEARCH_NUM(srr, trr(t), CStr(mrr(t)))  '查找
                    If s = Empty Then
                        temp = temp & delimiter & "缺卡" & t + 1
                    ElseIf s <> Empty And Abs(s - trr(t)) > sf Then  '查找的值为时间范围外
                        temp = temp & delimiter & "缺卡" & t + 1
                    End If
                Next
                arr(i, j) = Mid(temp, Len(delimiter) + 1): temp = ""
            End If
        Next
    Next
    Worksheets("结果").[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    Debug.Print "累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub

• 运行结果
  

2，同时判断迟到早退

mrr数组参数用于查找方式为，最接近上班时间、晚于下班时间的时间

Sub 考勤整理2()
    'sf时间范围，确定打卡时间归属哪个范围，1/24即前后各1小时
    Dim trr, mrr, arr, ignore_empty As Boolean, only_once As Boolean, start_r&, start_c&, delimiter$
    Dim sf#, i&, j&, t&, srr, s, temp$
'--------------------参数填写：标准上下班时间，对应查找模式
    trr = Array(#8:00:00 AM#, #12:00:00 PM#, #1:00:00 PM#, #5:30:00 PM#)
    mrr = Array("=", "=", "=", "=")
'--------------------参数填写：ignore_empty忽略空值；sf时间范围；开始行列号；分隔符
    ignore_empty = True: sf = 1 / 24: start_r = 2: start_c = 2: delimiter = Chr(10)
    arr = Worksheets("考勤").[a1].CurrentRegion.Value: tm = Timer
    For i = start_r To UBound(arr)
        For j = start_c To UBound(arr, 2)
            If Not (Len(arr(i, j)) = 0 And ignore_empty) Then  '非空且忽略空值
                srr = Split(arr(i, j), delimiter)
                For t = 0 To UBound(trr)
                    s = Empty: s = SEARCH_NUM(srr, trr(t), CStr(mrr(t)))  '查找
                    If s = Empty Then
                        temp = temp & delimiter & "缺卡" & t + 1
                    Else
                        If Abs(s - trr(t)) > sf Then  '查找的值为时间范围外
                            temp = temp & delimiter & "缺卡" & t + 1
                        ElseIf (t Mod 2 = 0) And s > trr(t) Then  '上班迟到
                            temp = temp & delimiter & "卡" & t + 1 & "迟"
                        ElseIf (t Mod 2 = 1) And s < trr(t) Then  '下班早退
                            temp = temp & delimiter & "卡" & t + 1 & "早"
                        End If
                    End If
                Next
                arr(i, j) = Mid(temp, Len(delimiter) + 1): temp = ""
            End If
        Next
    Next
    Worksheets("结果").[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    Debug.Print "累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub

• 运行结果
  

3，同时判断迟到早退，且时间范围为数组

sf参数改为数组，能分别确定各打卡时间的范围，超出范围的，就算未打卡，能够更精确的判断是否缺少打卡记录

Sub 考勤整理3()
    'sf时间范围，确定打卡时间归属哪个范围，1/24即前后各1小时，1/48即前后各半小时
    Dim trr, mrr, arr, ignore_empty As Boolean, only_once As Boolean, start_r&, start_c&, delimiter$
    Dim sf, i&, j&, t&, srr, s, temp$
'--------------------参数填写：标准上下班时间，对应查找模式；sf时间范围
    trr = Array(#8:00:00 AM#, #12:00:00 PM#, #1:00:00 PM#, #5:30:00 PM#)
    mrr = Array("=", "=", "=", "=")
    sf = Array(1 / 24, 1 / 48, 1 / 24, 1 / 24)
'--------------------参数填写：ignore_empty忽略空值；sf时间范围；开始行列号；分隔符
    ignore_empty = True: start_r = 2: start_c = 2: delimiter = Chr(10)
    arr = Worksheets("考勤").[a1].CurrentRegion.Value: tm = Timer
    For i = start_r To UBound(arr)
        For j = start_c To UBound(arr, 2)
            If Not (Len(arr(i, j)) = 0 And ignore_empty) Then  '非空且忽略空值
                srr = Split(arr(i, j), delimiter)
                For t = 0 To UBound(trr)
                    s = Empty: s = SEARCH_NUM(srr, trr(t), CStr(mrr(t)))  '查找
                    If s = Empty Then
                        temp = temp & delimiter & "缺卡" & t + 1
                    Else
                        If Abs(s - trr(t)) > sf(t) Then  '查找的值为时间范围外
                            temp = temp & delimiter & "缺卡" & t + 1
                        ElseIf (t Mod 2 = 0) And s > trr(t) Then  '上班迟到
                            temp = temp & delimiter & "卡" & t + 1 & "迟"
                        ElseIf (t Mod 2 = 1) And s < trr(t) Then  '下班早退
                            temp = temp & delimiter & "卡" & t + 1 & "早"
                        End If
                    End If
                Next
                arr(i, j) = Mid(temp, Len(delimiter) + 1): temp = ""
            End If
        Next
    Next
    Worksheets("结果").[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    Debug.Print "累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub

• 运行结果