Excel VBA 考勤数据提取/打卡考勤机数据提取填入考勤时间表

快速浏览

往期合集：【2023年3月】【2023年4月】【2023年5月】【2023年6月】【2023年7月】

实用案例|收费管理系统|中医诊所收费系统||日期控件|简单的收发存||电子发票管理助手|Excel表格拆分神器||Excel多种类型文件合并||电子发票登记系统（Access版）||批量生成凭证抽查底稿|收费使用项目|财务管理系统|内容提要

考勤机导出的数据处理

考勤数据填入定制考勤表

大家好，我是冷水泡茶，前两天在EXCELHOME论坛上看到一个求助贴：

他的原始考勤数据（考勤数据）表是这样子的，红框是重复的考勤记录：

他的需求表（考勤时间表）是这个样子的：

咋一看，好像没什么，不就是按条件查找数据嘛，但是一动手，卧槽，不好弄啊，不规则数据比较多，这两天一直在想这事，今天终于搞出点模样出来了，我们一起来看一看吧：

基本思路

1、把考勤数据读入数组。

2、通过间隔时间判断，删除掉重复的考勤记录。

3、然后把时间字段处理成“日"，和"hh:mm”格式分别存到数组的其他列中。

4、对每人每一日的考勤记录进行分析，整理出4种打卡时间：上午上班、上午下班、下午上班、下午下班。

5、把对应的打卡时间写入到目标表“考勤时间表”。

6、思路好像还比较清晰，但是做起来却费了不少脑筋。

程序代码

1、ExtractData，提取数据：

Sub ExtractData() Dim ws As Worksheet Dim arrTem(), lastRow As Integer, lastCol As Integer Dim CheckTime As String Dim Dic As Object, dKey As String, arrTime() Dim strDeleteRows As String Dim arr() Dim timeDifference As Integer Dim refTime As Integer Set ws = ThisWorkbook.Sheets("考勤数据") ws.Activate With ws lastRow = .UsedRange.Rows.Count lastCol = .UsedRange.Columns.Count arrTem = ws.Range(Cells(1, 1), Cells(lastRow + 1, lastCol)).Value For i = 2 To lastRow arrTem(i, 5) = Day(CDate(arrTem(i, 4))) '日 arrTem(i, 6) = Format(CDate(arrTem(i, 4)), "hh:mm") '时间 arrTem(i, 7) = "" Next For i = 3 To lastRow 'Stop timeDifference = DateDiff("n", CDate(arrTem(i - 1, 4)), CDate(arrTem(i, 4))) 'Stop If CStr(arrTem(i, 6)) <= "11:00" Or CStr(arrTem(i, 6)) >= "12:30" Then refTime = 20 Else refTime = 5 End If If Abs(timeDifference) <= refTime Then If CStr(arrTem(i, 6)) <= "11:45" Then strDeleteRows = strDeleteRows & i & "/" Else strDeleteRows = strDeleteRows & i - 1 & "/" End If End If Next strDeleteRows = "/" & strDeleteRows End With k = 1 ReDim arr(1 To lastRow, 1 To lastCol) For i = 2 To lastRow If InStr(strDeleteRows, "/" & i & "/") = 0 Then k = k + 1 For j = 1 To lastCol arr(k, j) = arrTem(i, j) Next End If Next For i = 2 To lastRow - 1 If arr(i, 5) <> arr(i - 1, 5) Then m = i End If If arr(i, 5) <> arr(i + 1, 5) Then n = i If m = n Then CheckTime = arr(m, 6) If CheckTime < "11:30" Then arr(m, 7) = "上午上班" ElseIf CheckTime < "12:00" Then arr(m, 7) = "下午上班" Else arr(m, 7) = "下午下班" End If Else For j = m To n CheckTime = CStr(arr(j, 6)) If j = m Then If CheckTime < "11:30" Then arr(m, 7) = "上午上班" Else arr(m, 7) = "下午上班" End If ElseIf j = n Then If CheckTime < "12:00" Then arr(n, 7) = "上午下班" Else arr(n, 7) = "下午下班" End If End If Next For j = m + 1 To n - 1 CheckTime = CStr(arr(j, 6)) If arr(j, 7) = "" Then If arr(j - 1, 7) = "上午上班" Then arr(j, 7) = "上午下班" ElseIf arr(j - 1, 7) = "上午下班" Then arr(j, 7) = "下午上班" End If End If Next End If End If Next For i = 2 To lastRow If arr(i, 7) <> "" Then arr(i, 8) = Int(InStr("上午上班上午下班下午上班下午下班", arr(i, 7)) / 4) + 1 End If Next ' Sheets("TEM").Range("A1").Resize(lastRow, lastCol) = arr' Sheets("TEM").Activate Set ws = ThisWorkbook.Sheets("考勤时间表") ws.Activate lastRow = ws.UsedRange.Rows.Count lastCol = ws.UsedRange.Columns.Count For i = 4 To lastRow If i Mod 4 = 0 And Cells(i, 1) = "" Then lastRow = i Exit For End If Next Range(Cells(4, 5), Cells(lastRow, lastCol)).ClearContents For i = 4 To lastRow For j = 5 To lastCol If Cells(i, "c") <> "" Then For m = 1 To 4 For k = 2 To UBound(arr, 1) If arr(k, 2) = Cells(i, "c") And arr(k, 5) = Cells(2, j) And arr(k, 8) = m Then Cells(i + m - 1, j) = arr(k, 6) End If Next Next End If Next NextEnd Sub‍

代码解析：（1）定义一些变量、数组、字典，字典好像也没有用到，不管它了。

（2）把ws设为源工作表“考勤数据”表。（3）把数据装入arrTem数组，对日期字段进处理，生成两个其他字段供后续比较使用，这里主要是把年、月的信息给去掉，否则没法比较，下个月可能也无法使用。（4）通过比较前后时间的间隔，判断是否是重复打卡时间，记下行号。这里使用了一个变量refTime，参考时间，上午11:00之前，下午12:30之后，设为20分钟，11:00~12:30设为5分钟，可以根据需要修改。（5）循环数组，把标为重复时间的记录去掉，其余存入一个新的数组arr。（6）循环arr数组，根据同一天打卡的时间值分析，判断其应该属于哪种打卡类型。（7）再循环数组，把4种打卡类型分别标记为1234，以便跟目标表中4个考勤时段匹配。（8）有个注释掉的把数据写入工作表Sheets("TEM")的代码，是为了查看数据处理结果而使用的，这也算是一种调试代码的方法吧，输出到工作表查看，比较直观，当然也可以中断代码，在“视图”、“本地窗口”中查看各种变量的当前值。（9）激活目标表“考勤时间表”，通过各种字段的判断，最终把数据写入工作表。2、其他说明：

（1）原始考勤数据是按照姓名、日期时间排序的，在处理数据的时候，只是简单判断连续的一天就是某个人的考勤记录，没有把姓名加进去判断，极端情况下可能出现连续排列的同一天，有两个人的考勤的情况。

（2）对于标准的准时打卡方式：上午上班、上午下班、下午上班、下午下班应该是没有问题，但有一些不规则打卡时间，由于缺乏更多明确的判断规则，暂时无法处理，可能会造成数据异常。~~~~~~End~~~~~~

喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！

需要示例文件的朋友请稍微留意一下：

写文不易，分享免费，请关注、点赞、点在看、点广告、留言，如果不愿走上面的“流程”，打赏也行，万分感谢！