Excel·VBA考勤打卡记录数据整理

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

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

Private Function SEARCH_NUM(arr, target, Optional mode As String = "-")
    '函数定义SEARCH_NUM(数组，目标值，查找模式)按指定查找模式查找数组，返回最接近的值
    '3种查找模式，"+"即大于等于、"-"即小于等于、"="即绝对值
    '支持数字格式的数字数组，也支持字符串格式的数字数组
    Dim result, a
    result = none
    For Each a In arr
        a = CDbl(a)  '转为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

Sub 考勤数据整理()
    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).Column
    arr = [a1].CurrentRegion.Value
    Set 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) = v
        Else
            dict(k) = dict(k) & "," & v  '值为数字时间，用","分隔
        End If
    Next
    ks = dict.keys
    vs = dict.Items
    ReDim result(dict.count, UBound(trr) + 1) '从0开始计数，0即为条件，1开始为数据
    '横纵条件赋值到数组
    For r = 1 To UBound(result)  '纵向
        result(r, 0) = ks(r - 1)
    Next
    For 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)) Then
            temp = 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))))
            Next
        End If
    Next
    Set dict = Nothing  '清除字典，释放内存
    Range(write_cell).Resize(UBound(result) + 1, UBound(result, 2) + 1) = result
    '姓名日期键按","分列
    Columns(write_col + 1).Insert
    Columns(write_col).TextToColumns Comma:=True
    '时间格式
    Range(write_cell).Offset(, 2).Resize(UBound(result) + 1, UBound(result, 2)).NumberFormatLocal = "hh:mm"
    
End Sub

结果举例