Board logo

標題: 公司用門禁系統當考勤，資料需要人工比對 麻煩，需要幫助 [打印本頁]
作者: mack078    時間: 2013-5-20 16:02     標題: 公司用門禁系統當考勤，資料需要人工比對 麻煩，需要幫助

請教各位先進:

如果小弟手邊有份打卡資料需要作比對 但是人員出入的時間有非常多重覆時間

而我只要看當天第1次刷的 和最後一次刷的 如何比對查看??


以下為小弟的excel位置檔 謝謝
https://docs.google.com/file/d/0B-xRp_Mu1bOQcG1jSFAzVHByZDg/edit?usp=sharing


1天內 可能會有5~8次的進出記錄， 所以 排序之後 還要一個一個比對 非常人工，非常費時。
作者: mack078    時間: 2013-5-21 08:23

有大大能指點一下嗎 感謝
作者: GBKEE    時間: 2013-5-21 13:40

本帖最後由 GBKEE 於 2013-5-21 13:41 編輯

回復 2# mack078
  1. Option Explicit
  2. Sub Ex()
  3.     Dim AR(), i As Integer, R As Long, A, D_Max As String, D_Min As String, xlDay As String
  4.     xlDay = Format(Date, "YYYYMMDD")
  5.     With Sheets("刷卡資料庫")   ' ***  請修改為你的工作表名稱   ***
  6.         .Range("A:A").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
  7.                                                                     '進階篩選       : A欄 不重複 [員工編號] 於此工作表最右欄
  8.         R = .Cells(.Rows.Count, .Columns.Count).End(xlUp).Row       '工作表最右欄   : 最後列有資料的列數
  9.         If R = 1 Then Exit Sub                                      'R = 1          : 刷卡資料庫中沒資料
  10.         ReDim AR(1 To .Cells(.Rows.Count, .Columns.Count).End(xlUp).Row)
  11.         AR(1) = Array("員工編號", "姓名", "刷卡卡號", "部門", "職稱", "刷卡日期", "上班時間", "下班時間")
  12.         For i = 2 To .Cells(.Rows.Count, .Columns.Count).End(xlUp).Row
  13.             .Range("A1").AutoFilter 7, xlDay                        '自動篩選 :第7欄(刷卡日期) 準則 =xlDay
  14.             .Range("A1").AutoFilter 1, .Cells(i, .Columns.Count)    '自動篩選 :第1欄(ID)       準則 =工作表最右欄的I列
  15.             
  16.             R = .[A1].End(xlDown).Row
  17.             If R <> .Rows.Count Then                                '有篩選到資料: 最後一列的列號 <> Rows.Count=檔案最最後一列的列號
  18.                 D_Min = Application.Min(Sheet1.Range("H:H").SpecialCells(xlCellTypeVisible))
  19.                                                                     'SpecialCells(xlCellTypeVisible):可見儲存格
  20.                 D_Max = Application.Max(Sheet1.Range("H:H").SpecialCells(xlCellTypeVisible))
  21.                 If D_Min = D_Max Then D_Max = " "
  22.                 A = .Range("A" & R).Resize(1, 8)                    '篩出的資料最後一列之8欄範圍設為陣列元素
  23.                 A(1, 6) = xlDay                                     '修改 元素的值
  24.                 A(1, 7) = D_Min
  25.                 A(1, 8) = D_Max
  26.             Else         ' xlDay 的刷卡時間 沒篩選到資料: = Rows.Count=檔案最最後一列的列號
  27.                 .Range("A1").AutoFilter 7                           '不設定第7欄(刷卡日期)的準則
  28.                 R = .[A1].End(xlDown).Row
  29.                 A = .Range("A" & R).Resize(1, 8)                    '篩出的資料最後一列之8欄範圍設為陣列元素
  30.                 A(1, 6) = xlDay                                     '修改 元素的值
  31.                 A(1, 7) = ""
  32.                 A(1, 8) = ""
  33.                
  34.             End If
  35.             AR(i) = A                                               '修改 元素的值
  36.         Next
  37.         .AutoFilterMode = False                                     '取消 自動篩選 :刷卡資料庫,資料全部顯示.
  38.     End With
  39.     With Sheets("查詢").[A1] ' ***  請修改為你的工作表名稱   ***
  40.                                                                     '當日刷卡時間資料,置於另一工作表.[A1]
  41.         .CurrentRegion = ""                                         '清除舊有刷卡時間
  42.         .Resize(i - 1, UBound(AR) - 1).Value = Application.Transpose(Application.Transpose(AR))   '轉置AR陣列於範圍中
  43.     End With
  44. End Sub
複製代碼
作者: 准提部林    時間: 2013-5-21 17:08

也許可考慮樞紐分析表：
http://www.funp.net/841064
作者: stillfish00    時間: 2013-5-21 20:22

本帖最後由 stillfish00 於 2013-5-21 20:25 編輯

還有另一種...從外部資料的Microsoft Query對工作表查詢
不過要稍微懂SQL語法，底下是錄製後修改的VBA 程式

Sub ExcelQuery()
    Dim sSQL, driverID As Long
   
    driverID = 1046 'Excel2010:1046 ; Excel2003:790
    sSQL = Array("SELECT `Sheet4$`.員工編號, `Sheet4$`.姓名, `Sheet4$`.刷卡卡號, `Sheet4$`.部門, `Sheet4$`.職稱, `Sheet4$`.刷卡日期, " _
            , "Min(`Sheet4$`.刷卡時間) AS 上班時間, Max(`Sheet4$`.刷卡時間) AS 下班時間" _
            , " FROM `" & ThisWorkbook.FullName & "`.`Sheet4$` `Sheet4$`" _
            , " GROUP BY `Sheet4$`.員工編號, `Sheet4$`.姓名, `Sheet4$`.刷卡卡號, `Sheet4$`.部門, `Sheet4$`.職稱, `Sheet4$`.刷卡日期" _
           )

    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "ODBC;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName, _
        ";DefaultDir=" & ThisWorkbook.Path, _
        ";DriverId=" & driverID, _
        ";MaxBufferSize=2048;PageTimeout=5;") _
        , Destination:=Range("$A$1")).QueryTable
        .CommandText = Array(sSQL)
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "MS_QUERY_連線"
        .Refresh BackgroundQuery:=False
        '不保持連線
        .Delete
    End With
End Sub



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)