公司考勤机导出的时间都在同一格里，如何快速求时长，天数？

ai123126

公司考勤机导出的时间都在同一格里，要怎么才能快速求出一天的上班时长和当月的上班天数？

上班时间8:00-19:00，中午1小时休息时间。要怎么样才能直接统计？比如小傅是早上8点08分打卡，11:41分下班。12点07分上班，不超过午休1小时，最后的下班打卡时间是18:57分，那么统计是10小时。如果是8:15分打卡，1:41分下班。12点07分上班，不超过午休1小时， 下班时间是15:57分， 那么只能算9.5小时，以此类推。
求大神帮忙一下

zpy2

考勤现在都要精确到小时了。。。。

wengjl

增加3张表

然后，粘贴上以下代码（公司电脑，文档有加密）所以贴代码
Sub 考勤转换()
    ' https://club.excelhome.net/thread-1695078-1-1.html
    ' 2024-6-18
    Sheet5.Select
    Cells.NumberFormatLocal = "@"
    Cells.ClearContents            ' 清空上一次的统计数据
    Cells.Interior.ColorIndex = xlNone
    Cells(1, 1).Value = "工号"
    Cells(1, 2).Value = "姓名"
    Cells(1, 3).Value = "部门"
    For i = 1 To 31
      Cells(1, i + 3).Value = i          ' 写上日期
    Next i
    x5 = 1
    jsh = Sheet3.UsedRange.Rows.Count    ' 依据数据范围，获得行数，尾部数据隐藏不影响计数
    For x3 = 5 To jsh
      If Sheet3.Cells(x3, 9).Value = "姓 名:" Then             ' 找到姓名，则
        x5 = x5 + 1
        Sheet5.Cells(x5, 1).Value = Sheet3.Cells(x3, 3).Value  ' 记录工号
        Sheet5.Cells(x5, 2).Value = Sheet3.Cells(x3, 11).Value  ' 记录姓名
        Sheet5.Cells(x5, 3).Value = Sheet3.Cells(x3, 21).Value  ' 记录部门
        For y = 1 To 31                                         ' 按日期循环
          bb = Sheet3.Cells(x3 + 1, y).Value
          mysj = ""
          For i = 1 To Len(bb)
            If Mid(bb, i, 1) = ":" Then
              wz = i
              mysj = mysj & Mid(bb, wz - 2, 5) & Chr(10)   ' 2个时间值间加上换行符
            End If
          Next i
          Sheet5.Cells(x5, y + 3).Value = mysj      ' 记录一天的考勤
        Next y
      End If
    Next x3
   
End Sub

Sub 考勤取最值()
    Sheet6.Select
    Cells.NumberFormatLocal = "@"
    Cells.ClearContents            ' 清空上一次的统计数据
    Sheet5.Columns("A:C").Copy  ' 复制部门、工号、姓名
    Sheet6.Cells(1, 1).Select
    ActiveSheet.Paste         ' 粘贴
    For i = 1 To 31
      Cells(1, i + 3).Value = i    ' 写上日期
    Next i
    x6 = 2
    Do While Not (IsEmpty(Sheet6.Cells(x6, 1).Value))
      xm = Sheet6.Cells(x6, 1).Value
      x5 = 2
      Do While Not (IsEmpty(Sheet5.Cells(x5, 1).Value))
        If Sheet5.Cells(x5, 1).Value = xm Then
          For y = 1 To 31
            If InStr(1, Sheet5.Cells(x5, y + 3).Value, ":", 1) <> 0 Then       ' 如果有时间数
              If mymax(Sheet5.Cells(x5, y + 3).Value, "A") = mymax(Sheet5.Cells(x5, y + 3).Value, "Z") Then  ' 如果最大＝最小，说明只打卡1次
                Sheet6.Cells(x6, y + 3).Value = mymax(Sheet5.Cells(x5, y + 3).Value, "A")
              Else
                Sheet6.Cells(x6, y + 3).Value = mymax(Sheet5.Cells(x5, y + 3).Value, "A") & Chr(10) & mymax(Sheet5.Cells(x5, y + 3).Value, "Z")
              End If
            End If
          Next y
        End If
        x5 = x5 + 1
      Loop
      x6 = x6 + 1
    Loop
    Range("A1").Select
End Sub
Function mymax(c_sj As String, Optional Options As String = "A")   ' 接收数值的变量是 n 。Integer 类型的值只有5位数。 Variant 类型的数值范围最大
     ' 这是第一次用自定义函数，2022-10-14星期五
     ' 于2022-10-24星期一，将最大值和最小值二个自定义数合二为一，关键是括号中，增加“, Optional Options As String = "A" ”，变成一个接收数据，一个接收类型标记
     ' 这个自定义函数是算出最大值（一天打卡时间中的最大）
     Dim arr(10)
     Dim maxsj As String
     maxsj = "00:00"
     minsj = "99:99"
        js = 0
        ks = 1
        For i = 1 To Len(c_sj)
          If Mid(c_sj, i, 1) = Chr(10) Then
            js = js + 1                       ' 这个计数是为记录，换行符第几次出现
            arr(js) = Mid(c_sj, ks, i - ks)   ' arr(js)里，记录了 js 个时间值
            ks = i + 1
          End If
        Next i
        arr(js + 1) = Mid(c_sj, ks)    ' 通过对接收到的数据，进行分享，暂存数组中
        For j = 1 To js + 1
          If arr(j) > maxsj Then  'And InStr(1, arr(j), ":", 1) <> 0 Then
            maxsj = arr(j)       ' 从数组中取出最大值
          End If
          If arr(j) < minsj And arr(j) <> "     " And arr(j) <> "" Then
            minsj = arr(j)       ' 从数组中取出最小值
          End If
        Next j
     If UCase(Options) = "A" Then
       mymax = minsj       ' 将处理的结果，反馈给 SUB ，再按SUB的规则处理（即赋值给单元格A1）
     Else
       mymax = maxsj
     End If
End Function      ' Function ....... End Function 是自定义函数的格式规范

Sub 计算每天的小时数()
    '
    ' 遇到指定的符号（chr(10)）时，取值
    '
    ' 时间：2022-10-17
    '
    ' 思路：取出一天中的最大值与最小值，二值之差即为时间，超过8小时45分的部分为加班
    '
    Sheet7.Select
    Rows("1:1000").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Sheet6.Select
    Cells.Select
    Selection.Copy
    Sheet7.Select
    Range("A1").Select
    Selection.PasteSpecial
    Range("A1").Select
    Cells.Interior.ColorIndex = xlNone    ' 所有单元格颜色取消
    '---
      x7 = 2
      Do While Not (IsEmpty(Sheet7.Cells(x7, 3).Value))   ' 在表6中寻找姓名
          For y = 1 To 31
            minsj = ""
            maxsj = ""
            c_sj = Sheet7.Cells(x7, y + 3).Value
            If IsEmpty(c_sj) Then
              
            Else
              If InStr(1, c_sj, Chr(10), 0) = 0 Then
                Sheet7.Cells(x7, y + 3).Value = "打卡1次"
                Sheet7.Cells(x7, y + 3).Interior.ColorIndex = 34   ' 6-黄色，34－兰色
              Else
                minsj = Split(c_sj, Chr(10))(0)
                maxsj = Split(c_sj, Chr(10))(1)
                xs = Hour(maxsj) - Hour(minsj)
                fz = Minute(maxsj) - Minute(minsj)
                If fz < 0 Then   ' 分钟为负数，需要借1小时，化为分钟
                  xs = xs - 1
                  fz = fz + 60
                End If
                Sheet7.Cells(x7, y + 3).Value = xs & "时" & fz & "分"
              End If
            End If
          Next y
        x7 = x7 + 1
      Loop
      
End Sub

Gzev1

尝试做了统计时长部分，没有加其他规则，供楼主参考一下吧。

ai123126

Gzev1 发表于 2024-6-18 18:28
尝试做了统计时长部分，没有加其他规则，供楼主参考一下吧。

谢谢大佬~非常有用

ai123126

wengjl 发表于 2024-6-18 13:40
增加3张表

然后，粘贴上以下代码（公司电脑，文档有加密）所以贴代码

谢谢大佬， 我去学习看看