VBA：考勤数据分析

'***************************************************************************
'功能：考勤数据分析
'作者：刘相涛
'参数：请假申请文件，加班申请文件，法定节假日1，法定节假日2
'出力：将请假类型情况，加班情况以及日常考勤情况进行标记
'***************************************************************************
Function HRAnalysis(HRName_Leave As String, HRName_overtime As String, HRName_system As String, AcceptHolidays As String, AcceptHolidays1 As String)
    '审批编号，审批状态，审批结果,申请类型,发起人姓名,开始时间，结束时间
    Dim SHPNO As String, SHPStatus As String, SHPResult As String, SQType As String, DingName As String, DingStartTime As String, DingEndTime As String, Days As String
    '定义工作簿对象
    Dim thisworkbook As Workbook, thisworksheet As Worksheet, Leave_cnt As Integer, Overtime_cnt As Integer
    '发起人姓名，部门,考勤日期，开始时间，结束时间,申请天数,审批状态，审批结果
    Dim Name As String, Department As String, HRData As String, StartTime As String, EndTime As String
    '计数工具
    Dim i As Integer, j As Integer, k As Integer, NewRange As Integer, n As Integer, tmpat1 As Integer, tmpat As Integer, Leave_i As Integer, No As Integer
    Dim flag As Boolean, flag1 As Boolean
    '钉钉导出请假、加班申请文件的总记录数,考勤系统记录数
    Dim SumRange As Integer, HRSumRange As Integer, tmpSQType As String, WriteFlag As Boolean
    Dim OtherArray As Variant
    OtherArray = ReadFileArray("D:不参与考勤人员.txt")
    '关闭刷屏
    Application.ScreenUpdating = False
    '确定当前打开的文件是否是钉钉导出的请假数据文件
    If Trim(Workbooks(HRName_Leave).Worksheets(1).Cells(1, 1).Value) <> "审批编号" _
        Or Trim(Workbooks(HRName_Leave).Worksheets(1).Cells(1, 3).Value) <> "审批状态" _
        Or Trim(Workbooks(HRName_Leave).Worksheets(1).Cells(1, 4).Value) <> "审批结果" _
        Or Trim(Workbooks(HRName_Leave).Worksheets(1).Cells(1, 8).Value) <> "发起人姓名" _
        Or Trim(Workbooks(HRName_Leave).Worksheets(1).Cells(1, 9).Value) <> "发起人部门" _
        Or Trim(Workbooks(HRName_Leave).Worksheets(1).Cells(1, 14).Value) <> "申请类型" _
        Or Trim(Workbooks(HRName_Leave).Worksheets(1).Cells(1, 17).Value) <> "申请天数(天)" Then
        '不符合要求是提示并终止程序执行
        MsgBox ("从钉钉导出的考勤数据不符合要求，请确认后重试")
        Exit Function
    Else
        Leave_cnt = Workbooks(HRName_Leave).Worksheets.Count
    End If
    '确定当前打开的文件是否是钉钉导出的加班数据文件
    If Trim(Workbooks(HRName_overtime).Worksheets(1).Cells(1, 1).Value) <> "审批编号" Or _
        Trim(Workbooks(HRName_overtime).Worksheets(1).Cells(1, 3).Value) <> "审批状态" Or _
        Trim(Workbooks(HRName_overtime).Worksheets(1).Cells(1, 4).Value) <> "审批结果" Or _
        Trim(Workbooks(HRName_overtime).Worksheets(1).Cells(1, 8).Value) <> "发起人姓名" Or _
        Trim(Workbooks(HRName_overtime).Worksheets(1).Cells(1, 9).Value) <> "发起人部门" Or _
        Trim(Workbooks(HRName_overtime).Worksheets(1).Cells(1, 14).Value) <> "开始时间" Or _
        Trim(Workbooks(HRName_overtime).Worksheets(1).Cells(1, 16).Value) <> "时长" Then
        '不符合要求是提示并终止程序执行
        MsgBox ("从钉钉导出的加班数据不符合要求，请确认后重试")
        Exit Function
    Else
        Overtime_cnt = Workbooks(HRName_overtime).Worksheets.Count
    End If
    '-----------------------------考勤系统导出数据文件HRName_system----------------------------------------------
    Set thisworkbook = Workbooks(HRName_system)
    k = 1
    '统计考勤系统导出的数据文件行数(含header)
    HRSumRange = 1
    '统计考勤系统导出文件行数
    Do While thisworkbook.Worksheets(1).Cells(k, 1).Value <> ""
        k = k + 1
    Loop
    '去header
    HRSumRange = k - 1
    If HRSumRange = 1 Then
        MsgBox ("考勤系统导出文件为空，请确认！")
    End If
    '-------------------------------------------------------------------------------------------
    thisworkbook.Activate   '激活打开的考勤系统数据文件
    Dim LastHoliday As Variant, LastHoliday1 As Variant  '法定节假日1,2
    Dim LastLeaveday As Variant, LastLeaveday1 As Variant
    Dim at As Integer, at1 As Integer
    '初始化变量
    LastHoliday = ""
    LastHoliday1 = ""
    LastLeaveday = ""
    LastLeaveday1 = ""
    WriteFlag = False
    at = 0
    at1 = 0
    j = 1
    '写题头
    Cells(j, 7).Value = "请假类型"
    Cells(j, 8).Value = "是否早退"
    Cells(j, 9).Value = "是否迟到"
    Cells(j, 10).Value = "是否迟到延退"
    Cells(j, 11).Value = "是否加班"
    Cells(j, 12).Value = "钉钉请假记录"
    '开始遍历数据源
    j = j + 1
    Call ShowPercent  '进度条
    Do While j <= HRSumRange   '直至末行
        '部门
        Department = Cells(j, 6).Value
        '姓名
        Name = Cells(j, 1).Value
        '考勤日期
        HRData = Cells(j, 2).Value
        '签到时间
        StartTime = Cells(j, 3).Value
        '签退时间
        EndTime = Cells(j, 4).Value
        If AcceptHolidays <> "-" Then
            LastHoliday = Split(Mid(AcceptHolidays, 5, 21), "-")   '考勤月份包含的第一个法定节假日
            LastLeavedays = Split(AcceptHolidays, "|")  '第一个法定节假日伴随的调休日（针对周六周日）
        Else
            LastHoliday = ""
            LastLeavedays = ""
        End If
        
        If AcceptHolidays1 <> "-" Then
            LastHoliday1 = Split(Mid(AcceptHolidays1, 5, 21), "-")  '考勤月份包含的第二个法定节假日
            LastLeavedays1 = Split(AcceptHolidays1, "|")  '第二个法定节假日伴随的调休日（针对周六周日）
        Else
            LastHoliday1 = ""
            LastLeavedays1 = ""
        End If
        '有调休日才处理，没有则跳过
        If LastLeavedays <> "" Then
            '根据调休日的天数循环判断，一般情况下一个法定假日最多有两个调休日
            LastLeaveday = Split(LastLeavedays(1), ",")
            For tmpat = 0 To UBound(LastLeaveday)
                If CDate(HRData) = LastLeaveday(tmpat) Then
                    flag = True   '是否处理开关，true为调休日，false为初始值
                Else
                    flag = False
                End If
            Next tmpat
        End If
        
        '同上
        If LastLeavedays1 <> "" Then
            LastLeaveday1 = Split(LastLeavedays1(1), ",")
            For tmpat1 = 0 To UBound(LastLeaveday1)
                If CDate(HRData) = LastLeaveday1(tmpat1) Then
                    flag1 = True
                Else
                    flag1 = False
                End If
            Next tmpat1
        End If
       '调用加班数据加载函数（不分节假日，无条件加载）
        Call OverTimeData(HRName_overtime, HRName_system, Overtime_cnt, j, Name, HRData)        
        If (Weekday(CDate(HRData)) <> 1 And Weekday(CDate(HRData)) <> 7) Or flag = True Or flag1 = True Then
            '9:00<  StartTime  <=9:30  或者 8:30<  StartTime  <=9:00  and 18:00<= EndTime <18:30   为迟到
            If (StartTime > "09:00" And StartTime <= "09:30") Or (StartTime > "08:30" And StartTime <= "09:00" And EndTime >= "18:00" And EndTime < "18:30") Then
                Cells(j, 9).Value = "迟到"
            End If
            '17:00<= EndTime <18:00  为早退
            If EndTime >= "17:00" And EndTime < "18:00" Then
                Cells(j, 8).Value = "早退"
            End If
            '8:30<  StartTime  <=9:00  and 18:30<= EndTime  为迟到延退
            If StartTime > "08:30" And StartTime <= "09:00" And EndTime >= "18:30" Then
                Cells(j, 10).Value = "迟到延退"
            End If
            '9:30<   StartTime or  EndTime <17:00 或者 StartTime is null or EndTime is null   为考勤异常
            If StartTime = "" Or EndTime = "" Or StartTime > "09:30" Or (EndTime <> "" And EndTime < "17:00") Then
                WriteFlag = True
                Cells(j, 7).Value = "旷工"
                'If Name = "张景" Then
                If (StartTime > "09:30" And EndTime < "17:00") Or (StartTime > "09:30" And EndTime = "") Or (StartTime = "" And EndTime < "17:00") Or (StartTime = "" And EndTime = "") Then
                    Cells(j, 7).Value = "旷工:1天"
                End If
                If (StartTime <> "" And EndTime <> "" And StartTime <= "09:30" And EndTime < "17:00") Or (StartTime <> "" And StartTime <= "09:30" And EndTime = "") Or (StartTime > "09:30" And EndTime >= "17:00") Or (StartTime = "" And EndTime >= "17:00") Then
                    Cells(j, 7).Value = "旷工:0.5天"
                End If
                '考勤异常数据是否是法定节假日1
                If LastHoliday <> "" Then
                    If CDate(HRData) >= CDate(LastHoliday(0)) And CDate(HRData) <= CDate(LastHoliday(1)) Then
                        Cells(j, 7).Value = "法定节假日"
                    End If
                End If
                '考勤异常数据是否是法定节假日2
                If LastHoliday1 <> "" Then
                    If CDate(HRData) >= CDate(LastHoliday1(0)) And CDate(HRData) <= CDate(LastHoliday1(1)) Then
                        Cells(j, 7).Value = "法定节假日"
                    End If
                End If
                '针对不参与考勤人员进行特殊标记
                For No = LBound(OtherArray) To UBound(OtherArray)
                    If Name = OtherArray(No) Then
                        Cells(j, 7).Value = "不参与考勤"
                        Exit For
                    End If
                Next
            End If
            '将钉钉导出的请假数据文件作为当前的处理对象
            Set thisworkbook = Workbooks(HRName_Leave)
            Leave_i = 1
            Do While Leave_i <= Leave_cnt
                Set thisworksheet = thisworkbook.Sheets(Leave_i)
                '-----------------------------钉钉导出数据文件HRName_Leave----------------------------------------------
                i = 1
                '统计钉钉导出数据记录数(含header)
                SumRange = 1
                '统计钉钉导出数据行数
                Do While thisworksheet.Cells(i, 1).Value <> ""
                    i = i + 1
                Loop
                '去header
                SumRange = i - 1
                If SumRange = 1 Then
                   MsgBox ("钉钉导出的请假数据为空，请确认！")
                End If
                '循环处理对象文件数据
                For n = 2 To SumRange
                    '审批状态
                    SHPStatus = Trim(thisworksheet.Cells(n, 3).Value)
                     '审批结果
                    SHPResult = Trim(thisworksheet.Cells(n, 4).Value)
                    '发起人姓名
                    DingName = Trim(thisworksheet.Cells(n, 8).Value)
                    '申请类型
                    SQType = Trim(thisworksheet.Cells(n, 14).Value)
                    '请假申请开始时间
                    DingStartTime = Trim(thisworksheet.Cells(n, 15).Value)
                    '请假申请开始日期
                    DingStartDate = Left(DingStartTime, 10)
                    '请假申请结束时间
                    DingEndTime = Trim(thisworksheet.Cells(n, 16).Value)
                    '请假申请结束日期
                    DingEndDate = Left(DingEndTime, 10)
                    '请假时长（单位：天）
                    Days = Replace(Trim(thisworksheet.Cells(n, 17).Value), "小时", "")
                   If SHPStatus = "完成" And SHPResult = "同意" Then
                    '钉钉数据和考勤数据匹配的条件：姓名，考勤日期
                        If Name = DingName And CDate(HRData) >= CDate(DingStartDate) And CDate(HRData) <= CDate(DingEndDate) Then
                            Set thisworkbook = Workbooks(HRName_system)
                            If WriteFlag = True Then
                                '将请假类型及请假天数回写到对应的考勤数据中
                                '请假天数大于1天时
                                If CDbl(Days) > 1 Then
                                    '如果是整天，则每个考勤请假日填入1天，加和后就是请假的天数
                                    If (CDbl(Days) * 10) Mod 10 = 0 Then
                                        thisworkbook.Worksheets(1).Cells(j, 7).Value = SQType & ":" & CInt(Days) / CInt(Days) '相当于1,此处为表示意义写成公式
                                    '如果请假含半天，则填入：实际请假天数/（实际请假天数+0.5），并保留3位小数，加和后就是请假的天数
                                    Else
                                         thisworkbook.Worksheets(1).Cells(j, 7).Value = SQType & ":" & Round(CDbl(Days) / (CDbl(Days) + 0.5), 3)
                                    End If
                                '若小于1天（0.5天）,则把实际请假天数不做任何处理
                                 Else
                                    thisworkbook.Worksheets(1).Cells(j, 7).Value = SQType & ":" & Days
                                 End If
                            End If
                            '请假信息备注到考勤文件用于核对
                            tmpSQType = thisworkbook.Worksheets(1).Cells(j, 12).Value & ";" & SQType & ":" & Days
                            thisworkbook.Worksheets(1).Cells(j, 12).Value = Right(tmpSQType, Len(tmpSQType) - 1)
                            Exit For
                        End If
                    End If
                Next n
                Leave_i = Leave_i + 1
                Set thisworkbook = Workbooks(HRName_Leave)
                WriteFlag = False
            Loop
            If Weekday(CDate(HRData)) = 6 And Name = "刘相涛" And Cells(j, 7).Value <> "法定节假日" Then
                 Cells(j, 7).Value = "系统升级"
                 Cells(j, 8).Value = ""
                 Cells(j, 9).Value = ""
                 Cells(j, 10).Value = ""
            End If
            j = j + 1
            '刨去周末的考勤数据
        Else
            '考勤月份包含的第一个法定节假日非空
            If LastHoliday <> "" Then
                '处理数据的考勤日期属于法定节假日
                If CDate(HRData) >= CDate(LastHoliday(0)) And CDate(HRData) <= CDate(LastHoliday(1)) Then
                    Cells(j, 7).Value = "法定节假日"
                End If
            End If
             '考勤月份包含的第二个法定节假日非空
            If LastHoliday1 <> "" Then
                '处理数据的考勤日期属于法定节假日
                If CDate(HRData) >= CDate(LastHoliday1(0)) And CDate(HRData) <= CDate(LastHoliday1(1)) Then
                    Cells(j, 7).Value = "法定节假日"
                End If
            End If
            '处理下一条数据
            j = j + 1
        End If
    Loop  
    Application.DisplayAlerts = False
    Workbooks(HRName_system).Activate '激活考勤系统数据文件
    '关闭源数据和银行数据文件
    Workbooks(HRName_Leave).Close
    Workbooks(HRName_overtime).Close
    '打开屏幕刷新
    Application.ScreenUpdating = True
    '设置焦点
    Cells(1, 1).Select
    '完成提醒
    MsgBox ("Thanks for use！")
End Function