考勤系统

Sub Organize_Attendance()

On Error Resume Next

Application.ScreenUpdating = False

Dim Cus_FirstDay As Date, Cus_Lastday As Date, abcd As Date, Cus_Days, St2_Row, Arr_Pointer, Arr_Pointer2

Dim Sht, St1, St2, St3

Dim Arr(0 To 31000, 1 To 14), Date1, Date2, Date3, Record, Date4, Name

'整理表页名称，用于判断是否缺失

txt = ""

a = 0

b = 0

c = 0

For Each Sht In Sheets

IfSht.Name= "控制表格" Then a = 1

IfSht.Name= "出勤记录" Then b = 1

IfSht.Name= "输出表格" Then c = 1

Next

'查找是否有“控制表格”和“出勤记录”两张表

If a <> 1 And b = 1 Then

  txt = "没有找到控制表格表页"

ElseIf a = 1 And b <> 1 Then

  txt = "没有找到出勤记录表页"

ElseIf a <> 1 And b <> 1 Then

  txt = "没有找到控制表格、出勤记录表页"

End If

If txt <> "" Then

  MsgBox (txt)

  Exit Sub

End If

'如果有输出表格，则进行清空，如果没有新建一个

If c = 1 Then

  Sheets("输出表格").Cells.Delete

Else

  Sheets.Add

ActiveSheet.Name= "输出表格"

End If

Set St1 = Sheets("控制表格")

Set St2 = Sheets("出勤记录")

Set St3 = Sheets("输出表格")

'定义表头内容

Arr(0, 1) = "工号"

Arr(0, 2) = "姓名"

Arr(0, 3) = "单位名称"

Arr(0, 4) = "考勤日期"

Arr(0, 5) = "班次"

Arr(0, 6) = "上班"

Arr(0, 7) = "下班"

Arr(0, 8) = "是否跨天"

Arr(0, 9) = "在司时间"

Arr(0, 10) = "是否足够9小时"

Arr(0, 11) = "考勤是否合理"

Arr(0, 12) = "是否缺勤"

Arr(0, 13) = "备注"

'定义节假日、倒休等特殊日期字典

Set Date1 = CreateObject("Scripting.Dictionary")

Set Date2 = CreateObject("Scripting.Dictionary")

Set Date3 = CreateObject("Scripting.Dictionary")

For Each Rng In St1.Range("H2:H" & St1.Range("H65536").End(xlUp).Row)

  Date1.Add Rng.Value, Rng.Value

Next

For Each Rng In St1.Range("I2:I" & St1.Range("I65536").End(xlUp).Row)

  Date2.Add Rng.Value, Rng.Value

Next

For Each Rng In St1.Range("J2:J" & St1.Range("J65536").End(xlUp).Row)

  Date3.Add Rng.Value, Rng.Value

Next

'记录出勤记录行数

St2_Row = St2.Range("A65536").End(xlUp).Row

'定义月份第一天，当月天数

'Cus_FirstDay = DateSerial(St1.[b2].Value, St1.[b3].Value, 1)

'Cus_Lastday = DateSerial(St1.[b2].Value, St1.[b3].Value + 1, 0)

For i = 2 To St2_Row

  abcd = St2.Cells(i, 4).Value

  If Cus_FirstDay = #12:00:00 AM# Or Cus_FirstDay > abcd Then

      Cus_FirstDay = abcd

  End If

  If Cus_Lastday = #12:00:00 AM# Or Cus_Lastday < abcd Then

      Cus_Lastday = abcd

  End If

Next

Cus_Days = DateDiff("d", Cus_FirstDay, Cus_Lastday) + 1

'定义当月班次数组

ReDim Date4(1 To Cus_Days, 1 To 2)

For i = 1 To Cus_Days

  a = DateAdd("d", i - 1, Cus_FirstDay)

  Date4(i, 1) = a

  If Date1.Exists(a) Then

      Date4(i, 2) = "三倍节假日"

  ElseIf Date2.Exists(a) Then

      Date4(i, 2) = "周末"

  ElseIf Date3.Exists(a) Then

      Date4(i, 2) = "工作日"

  ElseIf WorksheetFunction.Weekday(a, 2) = 6 Then

      Date4(i, 2) = "周六"

  ElseIf WorksheetFunction.Weekday(a, 2) = 7 Then

      Date4(i, 2) = "周日"

  Else

      Date4(i, 2) = "工作日"

  End If

Next

'定义员工工号字典

Set Name = CreateObject("Scripting.Dictionary")

'定义当前员工第一行指针

Arr_Pointer = -Cus_Days

'开始按照出勤记录每行循环处理数据，记录工号、姓名、公司、班次、日期、上下班时间、是否跨天的数据

For i = 2 To St2_Row

  '将出勤记录当前行转换为数组

  Record = WorksheetFunction.Transpose(WorksheetFunction.Transpose(St2.Range("A" & i & ":E" & i).Value))

  '检测是否是录入过该员工

  If Not Name.Exists(Record(1)) Then

    '如果是第一次录入，增加工号字典，更改第一行指针，在数组内添加该员工一整月天数的前5列数据

      Name.Add Record(1), Record(1)

      Arr_Pointer = Arr_Pointer + Cus_Days

      For n = 1 To Cus_Days

          Arr(Arr_Pointer + n, 1) = Record(1)

          Arr(Arr_Pointer + n, 2) = Record(2)

          Arr(Arr_Pointer + n, 3) = Record(3)

          Arr(Arr_Pointer + n, 4) = Date4(n, 1)

          Arr(Arr_Pointer + n, 5) = Date4(n, 2)

      Next

  End If

  '判断时间属性，填入数组

  Arr_Pointer2 = Arr_Pointer + Day(St2.Cells(i, 4).Value)

  If St2.Cells(i, 5).Value >= TimeValue("13:00:00") Then '如果打卡时间超过13点

      If Arr(Arr_Pointer2, 7) = "" Then

          Arr(Arr_Pointer2, 7) = St2.Cells(i, 5).Value '如果数组里还没有记录，则将单元格写入数组

      ElseIf Arr(Arr_Pointer2, 7) < St2.Cells(i, 5).Value Then

          Arr(Arr_Pointer2, 7) = St2.Cells(i, 5).Value '如果数组的记录小于单元格，则将单元格写入数组（下班打卡取较大数据）

      End If

  ElseIf St2.Cells(i, 5).Value < TimeValue("6:00:00") Then '如果打卡时间早于6点

      If Day(Record(4)) = 1 Then

          Arr(Arr_Pointer2, 13) = "上个月末最后一天有加班"

      Else

          Arr_Pointer2 = Arr_Pointer2 - 1 '指针时间提前一天

          If Arr(Arr_Pointer2, 7) = "" Then

              Arr(Arr_Pointer2, 7) = St2.Cells(i, 5).Value '如果数组里还没有记录，则将单元格写入数组

          ElseIf Arr(Arr_Pointer2, 7) >= TimeValue("13:00:00") Then

              Arr(Arr_Pointer2, 7) = St2.Cells(i, 5).Value '如果数组里的记录是前一天晚上的记录，则将单元格写入数组（凌晨打卡要晚于前一天晚上）

          ElseIf St2.Cells(i, 5).Value > Arr(Arr_Pointer2, 7) Then

              Arr(Arr_Pointer2, 7) = St2.Cells(i, 5).Value '如果数组里的记录是凌晨的，并且小于单元格，则将单元格写入数组（下班打卡取较大数据）

          End If

          Arr(Arr_Pointer2, 8) = "是"

      End If

  Else '如果打卡时间介于6点到13点

      If Arr(Arr_Pointer2, 6) = "" Then

          Arr(Arr_Pointer2, 6) = St2.Cells(i, 5).Value '如果数组里还没有记录，则将单元格写入数组

      ElseIf Arr(Arr_Pointer2, 6) > St2.Cells(i, 5).Value Then

          Arr(Arr_Pointer2, 6) = St2.Cells(i, 5).Value '如果数组的记录大于单元格，则将单元格写入数组（上班打卡取较小数据）

      End If

  End If

Next

For i = 1 To Arr_Pointer + Cus_Days

  '备注周末or节假日

'    If Arr(i, 5) = "周末" Or Arr(i, 5) = "三倍节假日" Then

'        If Arr(i, 6) = "" And Arr(i, 7) = "" Then Arr(i, 13) = Arr(i, 13) & " 周末or节假日 "

'    End If

  '如果上下班都有时间，则填充在司时间

  If Arr(i, 6) <> "" And Arr(i, 7) <> "" Then

      If Arr(i, 8) = "是" Then

          Arr(i, 9) = Arr(i, 7) + 1 - Arr(i, 6)

      Else

          Arr(i, 9) = Arr(i, 7) - Arr(i, 6)

      End If

      Arr(i, 9) = Application.WorksheetFunction.RoundDown(Arr(i, 9) * 24, 2)

      If Arr(i, 9) >= 9 Then Arr(i, 10) = "是"

  End If

  '判断是否缺上下班打卡记录

  If Arr(i, 5) = "工作日" Then

      '判断总部考勤是否合理

      If Arr(i, 3) = "总部" Then

          If Arr(i, 6) = "" And Arr(i, 7) = "" Then

              Arr(i, 12) = "缺勤"

          ElseIf Arr(i, 6) = "" Or Arr(i, 7) = "" Then

              Arr(i, 12) = "漏打卡"

          ElseIf Arr(i, 6) <= TimeValue("08:30:00") And (Arr(i, 7) >= TimeValue("17:30:00") Or Arr(i, 7) <= TimeValue("06:00:00")) Then

              Arr(i, 11) = "合理"

          ElseIf Arr(i, 6) <= TimeValue("09:00:00") And (Arr(i, 7) >= TimeValue("18:00:00") Or Arr(i, 7) <= TimeValue("06:00:00")) Then

              Arr(i, 11) = "合理"

          Else

              Arr(i, 11) = "迟到or早退"

          End If

      End If

      '判断金佰达考勤是否合理

      If Arr(i, 3) = "金佰达" Then

          '如果上下班都没打卡，前一天下班时间又不是晚于凌晨两点的，是缺勤

          If Arr(i, 6) = "" And Arr(i, 7) = "" Then

              If Arr(i - 1, 1) = Arr(i, 1) And Arr(i - 1, 7) <= TimeValue("06:00:00") And Arr(i - 1, 7) >= TimeValue("02:00:00") Then

                  Arr(i, 11) = "合理"

              Else

                  Arr(i, 12) = "缺勤"

              End If

          '如果上下班有一次没打卡，前一天下班时间又不是晚于凌晨两点的，是漏打一次卡

          ElseIf Arr(i, 6) = "" Or Arr(i, 7) = "" Then

              If Arr(i - 1, 1) = Arr(i, 1) And Arr(i - 1, 7) <= TimeValue("06:00:00") And Arr(i - 1, 7) >= TimeValue("02:00:00") Then

              Else

                  Arr(i, 12) = "漏打卡"

              End If

          '打卡时间早于8点半、晚于17点半是合理的

          ElseIf Arr(i, 6) <= TimeValue("08:30:00") And Arr(i, 7) >= TimeValue("17:30:00") Then

              Arr(i, 11) = "合理"

          '打卡时间早于8点半、并且下班跨天是合理的

          ElseIf Arr(i, 6) <= TimeValue("08:30:00") And Arr(i, 8) = "是" Then

              Arr(i, 11) = "合理"

          '打卡时间早于9点、在司时间大于9小时是合理的

          ElseIf Arr(i, 6) <= TimeValue("09:00:00") And Arr(i, 9) >= 9 Then

              Arr(i, 11) = "合理"

          '(同一个人)头一天晚上打卡时间介于2点到6点之间的是合理的

          ElseIf Arr(i - 1, 1) = Arr(i, 1) And Arr(i - 1, 7) <= TimeValue("06:00:00") And Arr(i - 1, 7) >= TimeValue("02:00:00") Then

              Arr(i, 11) = "合理"

          '(同一个人)头一天晚上打卡时间介于0点到2点之间，第二天早晨早于13点，晚上晚于18点是合理的

          ElseIf Arr(i - 1, 1) = Arr(i, 1) And Arr(i - 1, 7) <> "" And Arr(i - 1, 7) < TimeValue("02:00:00") And _

          Arr(i, 6) <= TimeValue("13:00:00") And Arr(i, 7) >= TimeValue("18:00:00") Then

              Arr(i, 11) = "合理"

          '(同一个人)头一天晚上打卡时间晚于20点，第二天早晨早于9点20，晚上晚于18点是合理的

          ElseIf Arr(i - 1, 1) = Arr(i, 1) And Arr(i - 1, 7) >= TimeValue("20:00:00") And _

          Arr(i, 6) <= TimeValue("09:20:00") And Arr(i, 7) >= TimeValue("18:00:00") Then

              Arr(i, 11) = "合理"

          '(同一个人)头一天晚上打卡时间晚于22点，第二天早晨早于10点，晚上晚于18点是合理的

          ElseIf Arr(i - 1, 1) = Arr(i, 1) And Arr(i - 1, 7) >= TimeValue("22:00:00") And _

          Arr(i, 6) <= TimeValue("10:00:00") And Arr(i, 7) >= TimeValue("18:00:00") Then

              Arr(i, 11) = "合理"

          Else

              Arr(i, 11) = "迟到or早退"

          End If

      End If

  End If

Next

'设置输出表的格式

St3.Columns("A:A").NumberFormatLocal = "@"

St3.Columns("D:D").NumberFormatLocal = "[$-F800]dddd, mmmm dd, yyyy"

St3.Columns("F:G").NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"

St3.Columns("I:I").Style = "Comma"

St3.Columns("B:M").ColumnWidth = 12

'结果数组输出到表格内

St3.Range("A1:N" & Arr_Pointer + Cus_Days) = Arr()

'清除无打卡记录的休息日行

'St3.Columns("N:N").SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete

Application.ScreenUpdating = True

St3.Select

St3.Range("a2").Select

ActiveWindow.FreezePanes = True

End Sub