公司指纹机生成数据

之前没怎么接触过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

生成结果文件