判斷單元格是否存在打卡記錄（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 = TrueApplication.ScreenUpdating = TrueEnd Sub
現在市面上有很多考勤機，大部分都很智慧化，匯出的打卡記錄表格規範易於整理。但總是有著一些奇葩的考勤機讓統計工作變得極為複雜。
（因為無法上傳附件，程式碼貼在文章最後，有需求的可以根據自己實際需要改的。如果不懂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 = TrueApplication.ScreenUpdating = TrueEnd Sub