VBA快速动态考勤统计

编程入门行业动态更新时间:2024-10-10 13:15:47

VBA快速动态<a href=https://www.elefans.com/category/jswz/34/1762901.html style= 考勤统计"/>

VBA快速动态考勤统计

实例需求：某公司的上下班打卡记录如下所示，其中Table_In为上班打卡记录，Table_Out为下班打卡记录。

现在需要根据日期整理为如下格式的考勤表。需要注意如下几点：

每天的打卡次数不确定
最后一列Total/Day统计该天的出勤总时长，忽略有缺卡的时间段
对于缺卡记录标记为Missing，例如10/14，员工108500，7:59:34和14:59:34两次上班打卡记录之间并没有下班打卡记录，那么7:59:34对应的下班打卡记录为缺失

示例代码如下。

Sub Demo()Const MISSING_DT = "Missing"Dim objDic As Object, rngData As RangeDim i As Long, j As LongDim arrData, arrRes(), arrTotal(), sKeyDim oSht As Worksheet, srcSheet As WorksheetSet objDic = CreateObject("scripting.dictionary")Set srcSheet = Sheets("Sheet1") Set oSht = Sheets.AddsrcSheet.ListObjects("Table_In").Range.Copy oSht.Cells(1, 1)oSht.Range("D1") = "Flag"oSht.Range(oSht.ListObjects(1).Name & "[Flag]").Value = "In"srcSheet.ListObjects("Table_Out").DataBodyRange.Copy oSht.Cells(1, 1).End(xlDown).Offset(1)oSht.Range(oSht.ListObjects(1).Name & "[Flag]").SpecialCells(xlCellTypeBlanks).Value = "Out"oSht.ListObjects(1).Range.Sort key1:="ID Number", Order1:=xlAscending, key2:="Date", _Order2:=xlAscending, key3:="Time", Order3:=xlAscending, Header:=xlYesarrData = oSht.ListObjects(1).DataBodyRange.ValueoSht.ListObjects(1).Range.ClearDim pair_cnt As IntegerReDim arrRes(UBound(arrData), 1 To 2)ReDim arrTotal(UBound(arrData), 0)arrRes(0, 1) = "Date"arrRes(0, 2) = "ID Number"arrTotal(0, 0) = "Total/Day"j = 0: pair_cnt = 0For i = LBound(arrData) To UBound(arrData)sKey = arrData(i, 1) & "|" & arrData(i, 2)If objDic.exists(sKey) ThenobjDic(sKey) = objDic(sKey) + 1Elsej = j + 1arrRes(j, 1) = arrData(i, 1)arrRes(j, 2) = arrData(i, 2)objDic(sKey) = 1End IfIf objDic(sKey) > pair_cnt Thenpair_cnt = objDic(sKey)ReDim Preserve arrRes(UBound(arrData), 1 To pair_cnt * 2 + 2)arrRes(0, pair_cnt * 2 + 1) = "In_" & pair_cntarrRes(0, pair_cnt * 2 + 2) = "Out_" & pair_cntEnd IfIf arrData(i, 4) = "In" ThenarrRes(j, objDic(sKey) * 2 + 1) = arrData(i, 3)If arrData(i + 1, 4) = "Out" ThenarrRes(j, objDic(sKey) * 2 + 2) = arrData(i + 1, 3)arrTotal(j, 0) = arrTotal(j, 0) + arrData(i + 1, 3) - arrData(i, 3)i = i + 1ElsearrRes(j, objDic(sKey) * 2 + 2) = MISSING_DTEnd IfElsearrRes(j, objDic(sKey) * 2 + 1) = MISSING_DTarrRes(j, objDic(sKey) * 2 + 2) = arrData(i, 3)End IfNext iWith oSht.Range("A3").Resize(UBound(arrRes), UBound(arrRes, 2)).Value = arrRes.Offset(0, 2).Resize(, pair_cnt * 2 + 1).EntireColumn.NumberFormat = "h:mm:ss".End(xlToRight).Offset(0, 1).Resize(UBound(arrRes), 1) = arrTotalEnd With
End Sub

【代码解析】
第7行代码创建自怼对象
第9行代码添加工作表用于保存临时数据。
第10行代码将表格Table_In的数据拷贝到新建工作表。
第11~12行代码增加新列Flag，并填充In，标记为上班打卡记录。
第13~14行代码表格Table_Out的数据拷贝到新建工作表，并增加新列。
第15行代码在新建工作表中对数据进行排序，排序字段依次为：ID Number, Date, Time
第16行代码将排序后的数据读取到数组中。
第18行代码清除新建工作表中的数据，以便于后续用于保存统计结果。
第20行代码声明数组arrRes用于保存考勤表。
第21行代码声明数组arrTotal用于保存出勤时间。
第22~24行代码填充表头
第26~55行代码循环处理考勤数据。
第27行代码将ID Number, Date作为排重统计的关键字段。
第28行代码判断字段中是否已经存在指定的关键字段。
如果已经存在，第29行代码将统计出现次数。
如果不存在，第32~33行代码将ID Number, Date保存到结果数组中。
第36~41行代码根据统计结果扩展结果数组。
第42~54行代码统计出勤时间和缺卡记录。
如果当前行为上班打卡记录，第43行代码记录上班打卡时间。
如果下一行为下班打卡记录，第45行代码记录下班打卡时间，并且第46行代码统计出勤时间。
如果下一行为不是下班打卡记录，第49行代码记录缺卡。
类似逻辑，第52~53行代码记录上班缺卡和相应的下班打卡时间。
第57行代码将考勤结果写入结果工作表中。
第58行代码设置最后一列的数字格式。
第59行代码将出勤时间写入工作表。