考勤数据标准化处理（考勤标准化管理制度）

Option Explicit

Sub 处理考勤数据()

Dim kqStr As String, yfStr As String

Dim ghStr As String, xmStr As String

Dim xRow As Integer, iRow As Integer

Dim xCol As Integer, xLen As Integer

Dim oArr(1 To 10000, 1 To 6)

With Worksheets(1) '考勤数据表

yfStr = Split(.Range("C3").Value, "-", , vbTextCompare)(1)

For xRow = 6 To .UsedRange.Rows.Count Step 2

ghStr = .Range("C" & xRow - 1).Value '工号赋值给变量

xmStr = .Range("K" & xRow - 1).Value '姓名赋值给变量

For xCol = 1 To 31

kqStr = .Cells(xRow, xCol).Value '考勤记录赋值给变量

If Len(kqStr) > 3 Then

For xLen = 1 To Len(kqStr) Step 5

iRow = iRow + 1

oArr(iRow, 1) = yfStr '考勤月分

oArr(iRow, 2) = xCol '考勤日期

oArr(iRow, 3) = ghStr '工号

oArr(iRow, 4) = xmStr '姓名

oArr(iRow, 5) = CDate(Mid(kqStr, xLen, 5)) '分离时间

oArr(iRow, 6) = 状态(oArr(iRow, 5)) '判断结果

Next

End If

Next

Next

End With

With Worksheets("处理结果")

.Range("A:D").ClearContents

.Range("A1").Resize(, 6).Value = Array("考勤月分", "日期", "工号", "姓名", "打卡时间", "状态")

.Range("A2").Resize(iRow, 6).Value = oArr

End With

MsgBox "考勤数据标准化处理完毕，共计处理出 " & iRow & " 条记录！", , "处理完成"

End Sub

Function 状态(ByVal dkTime As Date) '判断刷卡结果

Select Case dkTime

Case Is <= #8:00:00 AM#

状态 = "正常"

Case Is < #12:00:00 PM#

状态 = "异常"

Case Is <= #2:00:00 PM#

状态 = "正常"

Case Is < #6:00:00 PM#

状态 = "异常"

Case Else

状态 = "正常"

End Select

End Function

Sub 处理考勤数据超级表()

Dim kqStr As String, yfStr As String

Dim ghStr As String, xmStr As String

Dim xRow As Integer, iRow As Integer

Dim xCol As Integer, xLen As Integer

Dim oArr(1 To 10000, 1 To 6)

Dim lst As ListObject

With Worksheets("考勤记录")

yfStr = Split(.Range("C3").Value, "-", , vbTextCompare)(1)

For xRow = 6 To .UsedRange.Rows.Count Step 2

ghStr = .Range("C" & xRow - 1).Value '工号赋值给变量

xmStr = .Range("K" & xRow - 1).Value '姓名赋值给变量

For xCol = 1 To 31

kqStr = .Cells(xRow, xCol).Value '考勤记录赋值给变量

If Len(kqStr) > 3 Then

For xLen = 1 To Len(kqStr) Step 5

iRow = iRow + 1

oArr(iRow, 1) = yfStr '考勤月分

oArr(iRow, 2) = xCol '考勤日期

oArr(iRow, 3) = ghStr '工号

oArr(iRow, 4) = xmStr '姓名

oArr(iRow, 5) = CDate(Mid(kqStr, xLen, 5)) '分离时间

oArr(iRow, 6) = 状态(oArr(iRow, 5)) '判断结果

Next

End If

Next

Next

End With

With Worksheets("处理结果")

For Each lst In .ListObjects

If lst.Name = "考勤数据" Then

lst.Range.Delete

Exit For

End If

Next

.Range("A1").Resize(, 6).Value = Array("考勤月分", "日期", "工号", "姓名", "打卡时间", "状态")

.Range("A2").Resize(iRow, 6).Value = oArr

.ListObjects.Add(xlSrcRange, .Range("$A$1").CurrentRegion, , xlYes).Name = "考勤数据"

End With

ActiveWorkbook.RefreshAll

MsgBox "考勤数据标准化处理完毕，共计处理出 " & iRow & " 条记录！", , "处理完成"

End Sub