主题：如何利用宏实现月底考勤核对自动化 |
| 正文： |
我们每月月底核对考勤增加了大量的工作量，如何实现核对的自动化呢，以下是自己的一点尝试，希望大家提出宝贵意见，谢谢！
主要分为5个步凑
1、将考勤机的数据导出，如下图
2、整理格式后，输入以下代码：
Sub 调整格式()
Dim i%, u%, ii%
Dim xx
On Error Resume Next
u = [a65536].End(xlUp).Row
Range("h2").Select
ActiveCell.FormulaR1C1 = "=RC[-6]-R[-1]C[-6]"
Selection.AutoFill Destination:=Range("H2" & ":" & "H" & u), Type:=xlFillDefault
Range("Q2").Select
ActiveCell.FormulaR1C1 = "4:00"
Selection.Copy Range("Q2" & ":" & "Q" & u)
Range("J2").Select
ActiveCell.FormulaR1C1 = "=value(RC[7]-RC[-7])"
Selection.AutoFill Destination:=Range("J2:J" & u), Type:=xlFillDefault
For i = 3 To u
ii = Application.WorksheetFunction.CountA(Range(Cells(i - 1, 3), Cells(i - 1, 7)))
If Range("J" & i) >= 0 And Range("a" & i - 1) = Range("a" & i) And Range("h" & i) = 1 Then
Range("c" & i).Select
Selection.Cut Destination:=Cells(i - 1, 9)
Range("c" & i).Interior.ColorIndex = 3
Cells(i - 1, 9).Interior.ColorIndex = 6
Else
GoTo 100
End If
100: Next i
Columns("H:H").Select
Selection.ClearContents
Columns("J:J").Select
Selection.ClearContents
Columns("Q:Q").Select
Selection.ClearContents
Call 截取上下班时间
End Sub
Sub 截取上下班时间()
Application.ScreenUpdating = False
Dim i%, x%, t%, u%
t = [a65536].End(xlUp).Row
For i = 2 To t
u = Application.WorksheetFunction.CountA(Range(Cells(i, 3), Cells(i, 9)))
For x = 3 To 9
If u > 1 And Cells(i, x) <> "" Then
Cells(i, 11) = Cells(i, x)
GoTo 200
Else
Cells(i, 10) = "缺勤"
GoTo 100
End If
100: Next x
200: Next i
Call 时间差2
End Sub
Sub 时间差2()
Dim i%, x%, t%, u%
t = [a65536].End(xlUp).Row
For i = 2 To t
u = Application.WorksheetFunction.CountA(Range(Cells(i, 3), Cells(i, 9)))
For x = 3 To 9
If u > 1 And Cells(i, x) <> "" Then
Cells(i, 12) = Cells(i, x)
Else
GoTo 100
End If
100: Next x
Next i
Call 调整凌晨
End Sub
Sub 调整凌晨()
Dim i%, x%, t%, u%
t = [a65536].End(xlUp).Row
For i = 2 To t
If Range("I" & i) <> "" Then Range("L" & i) = "23:59"
Next
Range("M2").Select
ActiveCell.FormulaR1C1 = "=value(TEXT(RC[-1]-RC[-2],""h.m""))"
Selection.AutoFill Destination:=Range("M2:M" & t), Type:=xlFillDefault
Columns("M:M").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("a1").Select
End Sub
3、运行后我们会看到
4、然后将此数据通过数据透视，整理为与行政排班统计表相同的格式，如下图
5，最后建立一张核对差异表，输入公式IF(最终整理核对版本!B2-行政统计工时!B2>=0,"","多计"&ABS(最终整理核对版本!B2-行政统计工时!B2))，然后全部复制公式，核对结果就出来了，见下图
|
|
|