AO獨自守候
現在市面上有很多考勤機，大部分都很智能化，導出的打卡記錄表格規範易於整理。但總是有著一些奇葩的考勤機讓統計工作變得極為複雜。
（因為無法上傳附件，代碼貼在文章最後，有需求的可以根據自己實際需要改的。如果不懂vba可能理解有難度）
如圖
這類考勤雖然看起來很直觀，但是實際統計考勤數據時候就變得很棘手了。
遇到這類請款應該怎麼辦呢，首先要考慮的是考勤機是否能自己調整格式，這個步驟是不能缺省，如果考勤機有相應的功能我們只需按照說明自動調整就好。否則吭哧吭哧做完後發現原來系統自帶模板，想死的心都有。
如果考勤機沒有相應功能，那麼就該考慮如何把圖中的數據變成一維表格。變成一維表格是因為，一維表格可以通過數據透視表靈活調整。
如何變為一維表格呢，考勤數據量大且該表格結構複雜，很顯然公式是很難做到的。（即使能用公式做，但由於打卡記錄數據量都不小，做出來也會奇卡無比）PQ和vba成為首選工具，由於我個人PQ水平一般，就選擇用vba處理以上數據。
具體思路：
- 判斷單元格是否存在打卡記錄（InStr(arr(i + k, x), ":") Instr函數判斷如果>0即說明存在打卡記錄），如果存在上下偏移就能獲得工號，日期等基本信息。將這些信息存在brr數組中。
- 由於存在一天多次打卡的情況，所以我用 For k = 1 To data_num+If InStr(arr(i + k, x), ":") > 0 Then聯合判斷如果存在，就記錄到數組brr中，沒有則退出循環。打卡次數是不固定的，所以這裡用data_num這個變量，初始值我給了10，即是如果一人一天打卡在10次以內都會記錄下。data_num可以根據個人需要更改，建議設置大些，不然可能存在有的打卡紀律未記錄的情況。
最後整理數據格式如下：
單擊按鈕
源代碼：
Sub Data_Clean()
Dim arr, brr(), i As Long, Lrow As Long, iyear As Integer, imonth As Integer
Dim sht As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'刪除‘員工刷卡記錄表’以外的工作表
For Each sht In Worksheets
If sht.Name <> "員工刷卡記錄表" Then
sht.Delete
End If
Next sht
With Worksheets("員工刷卡記錄表")
Lrow = .Cells(Rows.Count, "B").End(3).Row + 1
arr = .Range("B5:AF" & Lrow).Value
dDate = CDate(Split(.Range("z3"), "～")(1)) ' 取時間
iyear = Year(dDate)
imonth = Month(dDate)
End With
ReDim brr(1 To 25000, 1 To 34)
brr(1, 1) = "工號": brr(1, 2) = "姓名": brr(1, 3) = "部門": brr(1, 4) = "日期": brr(1, 5) = "打卡時間"
n = 2
' 遍歷數組
For i = 1 To UBound(arr)
If InStr(arr(i, 1), ":") > 0 Then
If arr(i - 1, 1) = 1 Then 'arr(i - 1, 1) = 1 且InStr(arr(i, 1), ":") > 0 說明此行為考勤記錄第一行
For x = 1 To UBound(arr, 2)
temp = Split(arr(i, x), Chr(10))
For j = 0 To UBound(temp)
If Trim(temp(j)) <> "" Then
brr(n, 1) = arr(i - 2, 3) '工號
brr(n, 2) = arr(i - 2, 11) '姓名
brr(n, 3) = arr(i - 2, 18) '部門
brr(n, 4) = CDate(iyear & "-" & imonth & "-" & arr(i - 1, x)) '日期
brr(n, 5) = temp(j)
n = n + 1
End If
Next j
'判斷第二組以後的打卡記錄，存在記錄在數組brr中
data_num = 10 '設定打卡固定值為10,如果一天內打卡超過10次，超過的部分不記錄
For k = 1 To data_num
If InStr(arr(i + k, x), ":") > 0 Then
temp = Split(arr(i + 1, x), Chr(10))
For j = 0 To UBound(temp)
If Trim(temp(j)) <> "" Then '如果不為空則記錄
brr(n, 1) = brr(n - 1, 1) '工號
brr(n, 2) = brr(n - 1, 2) '姓名
brr(n, 3) = brr(n - 1, 3) '部門
brr(n, 4) = brr(n - 1, 4) '日期
brr(n, 5) = temp(j)
n = n + 1
End If
Next j
Else
Exit For '不存在打卡記錄退出循環
End If
Next k
Next x
End If
End If
Next i
'創建工作表,將打卡記錄保存在“考勤數據”這個工作表中
Set sht = Worksheets.Add(after:=Worksheets(Worksheets.Count))
With sht
.Name = "考勤數據"
.Cells.Clear
.Range("a1").Resize(n, 5) = brr
.Activate
.Range("a1").Resize(n, 5).Borders.LineStyle = xlContinuous
MsgBox "完成"
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
飯後鐘
不知道你們的考勤表導出的打卡記錄是什麼格式，我就以下面這個格式來說說吧
如圖導出的打卡記錄有姓名、打卡日期、打卡時間。我們要將表一中的打卡時間統計出來，將每個人每天打卡情況是否正常，是否有遲到、早退現象。
第一步、區分上下午
我們要在明細表根據打卡時間來判別打卡時段是在上午或下午
第二步、判斷打卡是否正常
用函數：“=IF((E2="上午")*(HOUR(D2)>=9)*(MINUTE(D2)>0),"遲到\
分享到:
