Excel·VBA考勤打卡记录统计结果

之前写过的《Excel·VBA考勤打卡记录统计出勤小时》，是统计出勤小时；
之前写过的《Excel·VBA考勤打卡记录数据整理》，是整理上下班时间；
而《excelhome提问-考勤统计》，则是按照下列要求统计考勤结果：
1，上班时间晚于8点，算迟到
2，下班时间早于18点，算早退
3，上下班仅打卡1次，算休息半天
4，当天没有打卡记录，算未打卡
同时为避免一个班次多次打卡/每天打卡次数超过2次造成错误，改为获取当日打卡时间的max、min值判断获取考勤结果

与之前的文章同样采用字典嵌套字典的方式，同样由于office不支持时间数组max、min操作，故时间先读取为字符串，再转为double类型；同时对日期进行排序方便查看，排序调用了bubble_sort函数，代码详见《Excel·VBA数组冒泡排序函数》

Sub 考勤统计()Dim arr, brr, crr, name_dict As Object, date_dict As Object, i&, j&, r&, c&, resultarr = [a1].CurrentRegion.Value: tm = TimerSet name_dict = CreateObject("scripting.dictionary")Set date_dict = CreateObject("scripting.dictionary")For i = 2 To UBound(arr)xm = arr(i, 2): rq = DateValue(arr(i, 4)): date_dict(rq) = ""sj = Format(TimeValue(arr(i, 4)), "0.0000000000")'Debug.Print xm, TypeName(xm), rq, TypeName(rq), sj, TypeName(sj)If Not name_dict.exists(xm) Then  '姓名字典键不存在，新增Set name_dict(xm) = CreateObject("scripting.dictionary")  '字典嵌套End Ifname_dict(xm)(rq) = name_dict(xm)(rq) & "," & sjNextReDim result(name_dict.Count, date_dict.Count)  '从0开始计数，0即为条件，1开始为数据trr = bubble_sort(date_dict.keys)  '日期排序For j = 1 To UBound(result, 2)  '日期赋值result(0, j) = trr(j - 1)NextFor Each n In name_dict.keysr = r + 1: result(r, 0) = nFor c = 1 To UBound(result, 2)If Not name_dict(n).exists(result(0, c)) Thenresult(r, c) = "未打卡"Else'字符串以,开头，所以brr(0)为空值brr = Split(name_dict(n)(result(0, c)), ","): ReDim crr(1 To UBound(brr))For i = 1 To UBound(brr)  '时间string数组转double数组crr(i) = CDbl(brr(i))Nextmax_t = WorksheetFunction.Max(crr): min_t = WorksheetFunction.Min(crr)'上班下班只要缺1个卡即为"休息半天"If max_t < #10:00:00 AM# Or min_t > #2:00:00 PM# Thenresult(r, c) = result(r, c) & vbLf & "休息半天"End IfIf min_t > #8:00:00 AM# And min_t < #10:00:00 AM# Thenresult(r, c) = result(r, c) & vbLf & "迟到"End IfIf max_t > #2:00:00 PM# And max_t < #6:00:00 PM# Thenresult(r, c) = result(r, c) & vbLf & "早退"End IfEnd IfNextNextFor i = 1 To UBound(result)  '清除开头的换行符For j = 1 To UBound(result, 2)If Len(result(i, j)) > 0 ThenIf Left(result(i, j), 1) = vbLf Thenresult(i, j) = Mid(result(i, j), 2)End IfEnd IfNextNextWith Worksheets("考勤统计表")  '结果赋值.Cells.Clear.Cells(1, 1).Resize(UBound(result) + 1, UBound(result, 2) + 1) = result.Cells(1, 1) = "姓名/日期"With .[a1].CurrentRegion.Borders.LineStyle = xlContinuous.Font.Name = "微软雅黑".HorizontalAlignment = xlCenter.VerticalAlignment = xlCenterEnd WithEnd WithDebug.Print "考勤统计完成，用时：" & Format(Timer - tm, "0.00")
End Sub

结果

附件
CSDN：《Excel·VBA考勤打卡记录统计结果（附件）》
百度网盘：《Excel·VBA考勤打卡记录统计结果（附件）》，提取码：3jp3

Excel·VBA考勤打卡记录统计结果相关推荐

Excel.VBA 快速删除重复记录
Excel.VBA 快速删除重复记录日常工作中的工作表中经常会有重复记录,清除这些重复记录是一个繁琐的工作,即使在排序之后再进行手工筛选,也经常会出现遗漏,而使用VBA代码就可以快速准确地删除重复记 ...
js解析EXCEL考勤打卡记录
公司的打卡记录是直接发我们的.要自己一条条核对,相当困惑于是自己写了个导入EXCEL道勤记录的,友好查看打卡记录. 导入后,输入姓名,点击查询 <!doctype html> <h ...
钉钉API考勤打卡记录获取并存入数据库（python）
前言: 钉钉有个开发平台,通过API可以开发自己企业内部应用,钉钉开发文档顺序写的有点乱,花了挺长时间才看懂,我写了一个python脚本来获取考勤记录,当然能做的不止这些,可以删除公司成员,修改部门, ...
钉钉API考勤打卡记录获取(PHP + JS)
前言: 钉钉有个开发平台,通过API可以开发自己企业内部应用,钉钉开发文档顺序写的有点乱,花了挺长时间才看懂,我建立一个php后端以及一个单独网页(不运行在钉钉上)来获取考勤记录,当然能做的不止这些, ...
Excel·VBA统计表生成函数及应用实例
目录 1,汇总多行多列数据,生成二维横纵统计表举例 2,汇总的二维横纵统计表,拆分为多行多列数据举例 1,汇总多行多列数据,生成二维横纵统计表在之前写过的<Excel·VBA考勤打卡记录统 ...
如何用python处理excel简单考勤统计_如何使用Excel快速考勤，统计迟到早退等情况？...
作为人事考勤人员(我不是),每月面对成千上万的考勤打卡记录,用眼睛逐个考核....请问眼睛还好吗(手动滑稽) 文笔不好,直接上干货吧有如下原始考勤数据:原始打卡数据由于员工害怕打卡失败,会多次重复 ...
【钉钉-场景化能力包】考勤打卡
需求场景员工到岗通知:企业通过设置自定义考勤规则,员工打开钉钉后实现快速打卡,打卡结果即时通知到部门主管处,方便主管查看人员到岗情况. 员工绩效计算:员工通过钉钉快速上下班考勤,企业随时可获取到员工 ...
多条记录取最近日期的一条_Excel VBA：基于员工打卡记录的考勤数据统计
微信公众号:金融数学使用VBA做一个基于员工打卡记录的考勤数据分析工具; 1应用场景某公司通过门禁系统记录了每位员工上下班打卡时间,现在需要对一段特定时间内员工出勤情况进行统计分析,包含加班时间( ...
如何用python处理excel简单考勤统计_excel怎么通过打卡记录简单统计考勤?
很多公司上班是需要打卡的,我们公司打卡是采用刷脸的办法,每个月需要根据打卡的记录来算工资,那么如何利用打卡记录来大致统计下每个月哪些人哪些天到了呢?如何确定是否迟到呢? 软件名称:Excel2003绿 ...
排序excel怎么设置_Excel考勤打卡统计，这才是最简单的方法！
小编看了这样一个关于考勤打卡的求助: 从打卡机中导出的2016-2019年员工考勤信息问:如何统计2018/9/1-2018/12/31(含)每人打卡次数很明显,这是一个根据条件统计个数的问题.很 ...

Excel·VBA考勤打卡记录统计结果

Excel·VBA考勤打卡记录统计结果相关推荐

最新文章

热门文章