怎样将打卡记录生成考勤表?
现在市面上有很多考勤机,大部分都很智能化,导出的打卡记录表格规范易于整理。但总是有着一些奇葩的考勤机让统计工作变得极为复杂。
(因为无法上传附件,代码贴在文章最后,有需求的可以根据自己实际需要改的。如果不懂vba可能理解有难度)
如图
这类考勤虽然看起来很直观,但是实际统计考勤数据时候就变得很棘手了。
遇到这类请款应该怎么办呢,首先要考虑的是考勤机是否能自己调整格式,这个步骤是不能缺省,如果考勤机有相应的功能我们只需按照说明自动调整就好。否则吭哧吭哧做完后发现原来系统自带模板,想死的心都有。
如果考勤机没有相应功能,那么就该考虑如何把图中的数据变成一维表格。变成一维表格是因为,一维表格可以通过数据透视表灵活调整。
如何变为一维表格呢,考勤数据量大且该表格结构复杂,很显然公式是很难做到的。(即使能用公式做,但由于打卡记录数据量都不小,做出来也会奇卡无比)PQ和vba成为首选工具,由于我个人PQ水平一般,就选择用vba处理以上数据。
具体思路:
判断单元格是否存在打卡记录(InStr(arr(i + k, x), ":") Instr函数判断如果>0即说明存在打卡记录),如果存在上下偏移就能获得工号,日期等基本信息。将这些信息存在brr数组中。由于存在一天多次打卡的情况,所以我用 For k = 1 To data_num+If InStr(arr(i + k, x), ":") > 0 Then联合判断如果存在,就记录到数组brr中,没有则退出循环。打卡次数是不固定的,所以这里用data_num这个变量,初始值我给了10,即是如果一人一天打卡在10次以内都会记录下。data_num可以根据个人需要更改,建议设置大些,不然可能存在有的打卡纪律未记录的情况。最后整理数据格式如下:
单击按钮
源代码:
Sub Data_Clean() Dim arr, brr(), i As Long, Lrow As Long, iyear As Integer, imonth As Integer Dim sht As Worksheet Application.DisplayAlerts = False Application.ScreenUpdating = False '删除‘员工刷卡记录表’以外的工作表 For Each sht In Worksheets If sht.Name <> "员工刷卡记录表" Then sht.Delete End If Next sht With Worksheets("员工刷卡记录表") Lrow = .Cells(Rows.Count, "B").End(3).Row + 1 arr = .Range("B5:AF" & Lrow).Value dDate = CDate(Split(.Range("z3"), "~")(1)) ' 取时间 iyear = Year(dDate) imonth = Month(dDate) End With ReDim brr(1 To 25000, 1 To 34) brr(1, 1) = "工号": brr(1, 2) = "姓名": brr(1, 3) = "部门": brr(1, 4) = "日期": brr(1, 5) = "打卡时间" n = 2 ' 遍历数组 For i = 1 To UBound(arr) If InStr(arr(i, 1), ":") > 0 Then If arr(i - 1, 1) = 1 Then 'arr(i - 1, 1) = 1 且InStr(arr(i, 1), ":") > 0 说明此行为考勤记录第一行 For x = 1 To UBound(arr, 2) temp = Split(arr(i, x), Chr(10)) For j = 0 To UBound(temp) If Trim(temp(j)) <> "" Then brr(n, 1) = arr(i - 2, 3) '工号 brr(n, 2) = arr(i - 2, 11) '姓名 brr(n, 3) = arr(i - 2, 18) '部门 brr(n, 4) = CDate(iyear & "-" & imonth & "-" & arr(i - 1, x)) '日期 brr(n, 5) = temp(j) n = n + 1 End If Next j '判断第二组以后的打卡记录,存在记录在数组brr中 data_num = 10 '设定打卡固定值为10,如果一天内打卡超过10次,超过的部分不记录 For k = 1 To data_num If InStr(arr(i + k, x), ":") > 0 Then temp = Split(arr(i + 1, x), Chr(10)) For j = 0 To UBound(temp) If Trim(temp(j)) <> "" Then '如果不为空则记录 brr(n, 1) = brr(n - 1, 1) '工号 brr(n, 2) = brr(n - 1, 2) '姓名 brr(n, 3) = brr(n - 1, 3) '部门 brr(n, 4) = brr(n - 1, 4) '日期 brr(n, 5) = temp(j) n = n + 1 End If Next j Else Exit For '不存在打卡记录退出循环 End If Next k Next x End If End If Next i'创建工作表,将打卡记录保存在“考勤数据”这个工作表中Set sht = Worksheets.Add(after:=Worksheets(Worksheets.Count)) With sht .Name = "考勤数据" .Cells.Clear .Range("a1").Resize(n, 5) = brr .Activate .Range("a1").Resize(n, 5).Borders.LineStyle = xlContinuous MsgBox "完成" End With Application.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd SubCopyright © 广州京杭网络科技有限公司 2005-2024 版权所有 粤ICP备16019765号
广州京杭网络科技有限公司 版权所有