关于考勤统计写的工具 

 1 '自动考勤计算
 2 'by Captain Amazing
 3 '2020/7/6
 4 '2022/7/4更新迟到写入功能
 5 '2023/7/3做大的更改
 6 Sub AutomaticAttendanceCounting()
 7                                         
 8     Dim s, partStr As String                                                            '声明打卡记录串
 9                                         
10     Dim bottom As Integer                                                               '表示最大使用的行数
11                                         
12     Dim Mins, totalMins As Integer                                                      '表示每次迟到分钟数和总计迟到分钟数
13                                         
14     m = Month(Now)                                                                      '取得当前月份, 年份
15     yy = Year(Now)
16     daysOfLastMonth = Day(DateSerial(yy, m, 1 - 1))                                     '获取当前月1号的前一天的日期数, 就是上月的天数
17                                         
18     bottom = ActiveSheet.UsedRange.Rows.Count                                           '设置最大行号
19                                         
20     For y = bottom To 1 Step -1
21         If Range("B" & y) = "1" Then
22             Rows(y + 1).Resize(2).Insert                                                '循环处理每一行, 遇到1号日期就插入两个空行用于统计
23             
24             For x = 2 To (daysOfLastMonth + 1) Step 1                                   '循环处理每一天
25 
26                 For n = y + 3 To bottom + 2
27                     s = s + Trim(Cells(n, x))                                           '将一天中所有的打卡记录合并在一起
28                 Next
29                                                                                         
30                 If Len(s) = 0 Then
31                     Cells(y + 1, x) = "请假"                                            '没有打卡记录算请假
32                 
33                 ElseIf Len(s) <= 6 Then
34                     Cells(y + 1, x) = "异常"                                            '一天只打一次卡标记为异常
35                 
36                 Else                                                                    '打两次以上卡根据时间来设置迟到或加班或早退
37 
38                     partStr = Left(s, 5)                                                '处理第一次打卡(上班)
39                     Mins = DateDiff("n", TimeValue("7:30"), TimeValue(partStr))
40                     
41                     If Mins > 0 And Mins < 60 Then
42                         Cells(y + 1, x) = "迟到" & Mins
43                         totalMins = totalMins + Mins
44                     ElseIf Mins >= 60 Then
45                         Cells(y + 1, x) = "上请"
46                     End If
47                                                                                         '处理最后一次打卡(下班)
48                     partStr = Right(s, 6)
49                     Mins = DateDiff("n", TimeValue("18:00"), TimeValue(partStr))
50                     
51                     If Mins >= 25 Then
52                         Cells(y + 2, x) = "加班" & Round(Mins / 60, 1)
53                     ElseIf Mins >= -60 And Mins < -30 Then
54                         Cells(y + 2, x) = "早退"
55                     ElseIf Mins < -60 Then
56                         Cells(y + 2, x) = "下请"
57                     End If
58                 End If
59                 
60                 s = ""                                                                  '处理完一天的上下班考勤数据后重置打卡变量s, 迟到分钟数
61                 Mins = 0
62             Next
63             
64             bottom = y - 2                                                              '处理完成某一员工, 向上移动2行, 即1号上面的2行, 写入迟到分钟数, 重置迟到总分钟数
65             Cells(y + 1, x + 1) = "迟到" & totalMins
66             totalMins = 0
67         End If
68     Next
69 End Sub

 

posted @ 2024-02-05 10:02  Captain_Amazing  阅读(29)  评论(0)    收藏  举报