'***************************************************************************
'功能：考勤数据分析
'作者：刘相涛
'参数：请假申请文件，加班申请文件，法定节假日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
评论