《excel吧提问-转置打卡数据》，打卡记录进行数据整理，分别提取3个时间段的开始、结束时间。
与之前写过的《Excel·VBA考勤打卡记录统计出勤小时》要求不同，仅需要提取打卡时间，特殊之处在于开始时间要最晚，而结束时间要最早

将提取时间的特殊要求，定义为一个函数，后期调用时直接传参获取结果

Private Function SEARCH_NUM(arr, target, Optional mode As String = "-")'函数定义SEARCH_NUM(数组，目标值，查找模式)按指定查找模式查找数组，返回最接近的值'3种查找模式，"+"即大于等于、"-"即小于等于、"="即绝对值'支持数字格式的数字数组，也支持字符串格式的数字数组Dim result, aresult = noneFor Each a In arra = CDbl(a)  '转为Double格式If a = target ThenSEARCH_NUM = aExit 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 = resultEnd FunctionSub 考勤数据整理()Dim trr, mrr, arr, dict, k, v, i, ks, vs, result, r, c, temp
'--------------------参数填写：标准上下班时间，对应查找模式，结果写入区域地址trr = Array(#8:30:00 AM#, #12:00:00 PM#, #1:00:00 PM#, #5:30:00 PM#, #6:30:00 PM#, #11:00:00 PM#)mrr = Array("-", "+", "-", "+", "-", "=")write_cell = "h1"         '结果写入区域地址write_col = Range(write_cell).Columnarr = [a1].CurrentRegion.ValueSet dict = CreateObject("scripting.dictionary")For i = 2 To UBound(arr)k = CStr(arr(i, 3)) & "," & CStr(arr(i, 4)) '键，姓名日期v = Format(arr(i, 5), "0.0000000000")If Not dict.Exists(k) Then  '姓名字典键不存在，新增dict(k) = vElsedict(k) = dict(k) & "," & v  '值为数字时间，用","分隔End IfNextks = dict.keysvs = dict.ItemsReDim result(dict.count, UBound(trr) + 1) '从0开始计数，0即为条件，1开始为数据'横纵条件赋值到数组For r = 1 To UBound(result)  '纵向result(r, 0) = ks(r - 1)NextFor c = 1 To UBound(result, 2)  '横向result(0, c) = trr(c - 1)Next'对应时间赋值到数组For r = 1 To UBound(result)If dict.Exists(result(r, 0)) Thentemp = Split(vs(r - 1), ",")  '分割字典的值，字符串数字数组For c = 1 To UBound(result, 2)result(r, c) = CDate(SEARCH_NUM(temp, trr(c - 1), CStr(mrr(c - 1))))NextEnd IfNextSet dict = Nothing  '清除字典，释放内存Range(write_cell).Resize(UBound(result) + 1, UBound(result, 2) + 1) = result'姓名日期键按","分列Columns(write_col + 1).InsertColumns(write_col).TextToColumns Comma:=True'时间格式Range(write_cell).Offset(, 2).Resize(UBound(result) + 1, UBound(result, 2)).NumberFormatLocal = "hh:mm"End Sub

结果举例