关于考勤统计写的工具

'自动考勤计算
'by Captain Amazing
'2020/7/6
'2022/7/4更新迟到写入功能
'2023/7/3做大的更改
Sub AutomaticAttendanceCounting()
                                        
    Dim s, partStr As String                                                            '声明打卡记录串
                                        
    Dim bottom As Integer                                                               '表示最大使用的行数
                                        
    Dim Mins, totalMins As Integer                                                      '表示每次迟到分钟数和总计迟到分钟数
                                        
    m = Month(Now)                                                                      '取得当前月份, 年份
    yy = Year(Now)
    daysOfLastMonth = Day(DateSerial(yy, m, 1 - 1))                                     '获取当前月1号的前一天的日期数, 就是上月的天数
                                        
    bottom = ActiveSheet.UsedRange.Rows.Count                                           '设置最大行号
                                        
    For y = bottom To 1 Step -1
        If Range("B" & y) = "1" Then
            Rows(y + 1).Resize(2).Insert                                                '循环处理每一行, 遇到1号日期就插入两个空行用于统计
            
            For x = 2 To (daysOfLastMonth + 1) Step 1                                   '循环处理每一天

                For n = y + 3 To bottom + 2
                    s = s + Trim(Cells(n, x))                                           '将一天中所有的打卡记录合并在一起
                Next
                                                                                        
                If Len(s) = 0 Then
                    Cells(y + 1, x) = "请假"                                            '没有打卡记录算请假
                
                ElseIf Len(s) <= 6 Then
                    Cells(y + 1, x) = "异常"                                            '一天只打一次卡标记为异常
                
                Else                                                                    '打两次以上卡根据时间来设置迟到或加班或早退

                    partStr = Left(s, 5)                                                '处理第一次打卡(上班)
                    Mins = DateDiff("n", TimeValue("7:30"), TimeValue(partStr))
                    
                    If Mins > 0 And Mins < 60 Then
                        Cells(y + 1, x) = "迟到" & Mins
                        totalMins = totalMins + Mins
                    ElseIf Mins >= 60 Then
                        Cells(y + 1, x) = "上请"
                    End If
                                                                                        '处理最后一次打卡(下班)
                    partStr = Right(s, 6)
                    Mins = DateDiff("n", TimeValue("18:00"), TimeValue(partStr))
                    
                    If Mins >= 25 Then
                        Cells(y + 2, x) = "加班" & Round(Mins / 60, 1)
                    ElseIf Mins >= -60 And Mins < -30 Then
                        Cells(y + 2, x) = "早退"
                    ElseIf Mins < -60 Then
                        Cells(y + 2, x) = "下请"
                    End If
                End If
                
                s = ""                                                                  '处理完一天的上下班考勤数据后重置打卡变量s, 迟到分钟数
                Mins = 0
            Next
            
            bottom = y - 2                                                              '处理完成某一员工, 向上移动2行, 即1号上面的2行, 写入迟到分钟数, 重置迟到总分钟数
            Cells(y + 1, x + 1) = "迟到" & totalMins
            totalMins = 0
        End If
    Next
End Sub