公司指纹机生成数据
之前没怎么接触过VBA 花了1天时间学习，1天时间编码 收获还是不错。
Dim OutPutLog As Boolean
Sub getAllData()
'调试日志标识符
OutPutLog = True
'文件操作
Dim Fso As Object
Dim Ofile As Object
'创建文件
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Ofile = Fso.CreateTextFile("C:\Users\admin\Desktop\考勤统计结果.txt")
'员工姓名数组
Dim EmployeeArr
EmployeeArr = Array("童硕")
'存储员工信息临时数组(注意不能声明数组大小)
Dim Employees() As Variant
Ofile.WriteLine "柑客&独角兽 勤务统计表"
'对每个员工统计考勤信息
For Each Name In EmployeeArr
Dim EName As String
EName = Name
Employees = getInfoByName(EName)
Ofile.WriteLine "*********************************************************************"
Ofile.WriteLine "姓名：" + Employees(0)
Ofile.WriteLine "---------------------------------------------------------------------"
Ofile.WriteLine "迟到：" + CStr(Employees(5)) + "天"
Ofile.WriteLine "---------------------------------------------------------------------"
If Employees(5) > 0 Then
Ofile.WriteLine "迟到日期："
Ofile.WriteLine ""
For Each Item In Employees(2)
Ofile.WriteLine Item
Next
Ofile.WriteLine "---------------------------------------------------------------------"
End If
Ofile.WriteLine "未打卡：" + CStr(Employees(4)) + "天"
Ofile.WriteLine "---------------------------------------------------------------------"
If Employees(4) > 0 Then
Ofile.WriteLine "未打卡日期："
Ofile.WriteLine ""
For Each Item In Employees(1)
Ofile.WriteLine Item
Next
Ofile.WriteLine "---------------------------------------------------------------------"
End If
Ofile.WriteLine "迟到总时间：" + CStr(Employees(3)) + "分"
Ofile.WriteLine "*********************************************************************"
Next
'关闭文件输出流
Set Fso = Nothing
Set Ofile = Nothing
End Sub
Public Function getInfoByName(Name As String) As Variant
'返回勤务信息数组
Dim infoArr(6) As Variant
'处理起始行
Dim i As Long
'忘记打卡次数
Dim ForgetTimes As Integer
'忘记打卡日期动态数组
Dim ForgetDatesArr() As String
'迟到次数
Dim LateTimes As Integer
'迟到日期动态数组
Dim LateDatesArr() As String
'迟到日分钟数动态数组
Dim LateDateMinArr() As Integer
'迟到总时间(分)
Dim TotalLateMin As Long
'正常上班总时间(分)
Dim NormalWorkTime As Integer
'变量初始化
i = 5
ForgetTimes = 0
LateTimes = 0
TotalLateMin = 0
NormalWorkTime = DateDiff("n", "09:30", "18:00")
'不为空时循环
While Cells(i, 2) <> ""
If StrComp(Cells(i, 2), Name, vbTextCompare) = 0 Then
'Cells(i, 2).Value 姓名
'Cells(i, 4).Value 日期
'Cells(i, 5).Value 上班时间
'Cells(i, 6).Value 下班时间
If OutPutLog Then
Debug.Print "-------------------------------------------------------------------"
Debug.Print "上班时间:" + Cells(i, 5).Value + " 下班时间:" + Cells(i, 6).Value
End If
'忘记打卡处理
If Cells(i, 5).Value = "" Or Cells(i, 6).Value = "" Then
'数组大小从新分配，Preserve关键字保证不影响已经存储的数组值
ReDim Preserve ForgetDatesArr(ForgetTimes + 1)
ForgetDatesArr(ForgetTimes) = Cells(i, 4).Value
ForgetTimes = ForgetTimes + 1
Else '迟到处理
'区间 10:00 - 18:00
If TimeValue(Cells(i, 5).Value) > TimeValue("10:00") Or TimeValue(Cells(i, 6).Value) < TimeValue("18:00") Then
If TimeValue(Cells(i, 5).Value) > TimeValue("10:00") Then
TotalLateMin = TotalLateMin + DateDiff("n", "10:00", Cells(i, 5).Value)
If OutPutLog Then
Debug.Print "迟到时间:" + CStr(DateDiff("n", "10:00", Cells(i, 5).Value))
End If
End If
If TimeValue(Cells(i, 6).Value) < TimeValue("18:00") Then
TotalLateMin = TotalLateMin + DateDiff("n", Cells(i, 6).Value, "18:00")
If OutPutLog Then
Debug.Print "迟到时间:" + CStr(DateDiff("n", Cells(i, 6).Value, "18:00"))
End If
End If
ReDim Preserve LateDatesArr(LateTimes + 1)
LateDatesArr(LateTimes) = Cells(i, 4).Value
LateTimes = LateTimes + 1
Else
If TimeValue(Cells(i, 5).Value) >= TimeValue("09:30") And TimeValue(Cells(i, 6).Value) <= TimeValue("18:30") Then
'区间9:30-10:00,18:00-18:30
If DateDiff("n", Cells(i, 6).Value, Cells(i, 5).Value) < NormalWorkTime Then
TotalLateMin = TotalLateMin + NormalWorkTime - DateDiff("n", Cells(i, 5).Value, Cells(i, 6).Value)
If NormalWorkTime - DateDiff("n", Cells(i, 5).Value, Cells(i, 6).Value) > 0 Then
ReDim Preserve LateDatesArr(LateTimes + 1)
LateDatesArr(LateTimes) = Cells(i, 4).Value
LateTimes = LateTimes + 1
If OutPutLog Then
Debug.Print "迟到时间:" + CStr(NormalWorkTime - DateDiff("n", Cells(i, 5).Value, Cells(i, 6).Value))
End If
End If
End If
End If
End If
End If
End If
'行数向下移动1
i = i + 1
Wend
'信息赋值给数组
infoArr(0) = Name
infoArr(1) = ForgetDatesArr
infoArr(2) = LateDatesArr
infoArr(3) = TotalLateMin
infoArr(4) = ForgetTimes
infoArr(5) = LateTimes
getInfoByName = infoArr
End Function
生成结果文件
