Excel·VBA考勤打卡记录整理

看到一个帖子《excel吧-考勤一天四次打卡，快速找出缺卡》，每个人每天有4次打卡记录，需要整理出所有缺少的打卡记录
在这里插入图片描述
与之前的文章《Excel·VBA考勤打卡记录统计结果》结果形式类似
与之前的文章《Excel·VBA考勤打卡记录数据整理》查找上下班打卡时间的要求类似，可以使用其SEARCH_NUM函数（本文代码有修改）

时间数组查找函数

Function SEARCH_NUM(ByVal arr, ByVal target, Optional mode$ = "-")'函数定义SEARCH_NUM(数组，目标值，查找模式)按指定查找模式查找数组，返回最接近的值'3种查找模式，"+"即大于等于、"-"即小于等于、"="即绝对值'支持数字格式的数字数组，也支持字符串格式的数字数组Dim result, aresult = noneFor Each a In arra = CDbl(Format(a, "0.0000000000"))  '字符串转为Double格式If a = target ThenSEARCH_NUM = a: Exit FunctionElseIf mode = "+" And a > target ThenIf result = Empty Or result > a Then result = aElseIf mode = "-" And a < target ThenIf result = Empty Or result < a Then result = aElseIf mode = "=" ThenIf result = Empty Or (Abs(result - target) > Abs(a - target)) Then result = aEnd IfNextSEARCH_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 = TimerFor 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 Thentemp = temp & delimiter & "缺卡" & t + 1ElseIf s <> Empty And Abs(s - trr(t)) > sf Then  '查找的值为时间范围外temp = temp & delimiter & "缺卡" & t + 1End IfNextarr(i, j) = Mid(temp, Len(delimiter) + 1): temp = ""End IfNextNextWorksheets("结果").[a1].Resize(UBound(arr), UBound(arr, 2)) = arrDebug.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 = TimerFor 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 Thentemp = temp & delimiter & "缺卡" & t + 1ElseIf Abs(s - trr(t)) > sf Then  '查找的值为时间范围外temp = temp & delimiter & "缺卡" & t + 1ElseIf (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 IfEnd IfNextarr(i, j) = Mid(temp, Len(delimiter) + 1): temp = ""End IfNextNextWorksheets("结果").[a1].Resize(UBound(arr), UBound(arr, 2)) = arrDebug.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 = TimerFor 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 Thentemp = temp & delimiter & "缺卡" & t + 1ElseIf Abs(s - trr(t)) > sf(t) Then  '查找的值为时间范围外temp = temp & delimiter & "缺卡" & t + 1ElseIf (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 IfEnd IfNextarr(i, j) = Mid(temp, Len(delimiter) + 1): temp = ""End IfNextNextWorksheets("结果").[a1].Resize(UBound(arr), UBound(arr, 2)) = arrDebug.Print "累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub