GBKEE

回復 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

複製代碼