Board logo

標題: [發問] 上班時間問題請教 [打印本頁]
作者: rouber590324    時間: 2018-4-30 14:26     標題: 上班時間問題請教

DEAR ALL 大大
1. SHEET1 之資料庫內容如下
            A欄姓名                B欄日期                 C欄入廠時間                D欄出廠時間  
2列       卜鴻義                1070321               10703210759               10703211712
3列        魏士杰               1070321               10703210755               10703211203
4列       魏士杰                1070321               10703211254               10703211723   
5列       楊佳振                1070322               10703220753               10703221706
..........................................
2.問題點: 部分中午有外出用餐之人員會有2筆打卡資料(例:魏士杰 0321 有2筆  10703210755-10703211203 與 10703211254-10703211723 資料      )
3.需求於 SHEET2 內將 中午有外出用餐之2筆資料整合為一筆(例:魏士杰 0321 有2筆資料整合為 10703210755      10703211723  一筆上下班打卡時間資料 )      
   3.1. SHEET2 之資料庫內容如下
            A欄姓名                B欄日期                 C欄入廠時間                D欄出廠時間  
2列       卜鴻義                1070321               10703210759               10703211712
3列        魏士杰               1070321               10703210755               10703211723
4列       楊佳振                1070322               10703220753               10703221706
..........................................
4.煩不吝賜教.  THANKS*10000
作者: 准提部林    時間: 2018-4-30 21:32

請上傳檔案~~才好參考
作者: rouber590324    時間: 2018-5-2 09:01

DER  准提部林  大大
1.公司電腦,限制無法上傳檔案與下載檔案.
   故方用文字書寫.尚請見諒.SORRY*10000
作者: Hsieh    時間: 2018-5-2 09:40

  1. Sub ex()
  2. Set dic = CreateObject("Scripting.Dictionary")
  3. With Sheets(1)
  4. For Each a In .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
  5. If IsEmpty(dic(a & a.Offset(, 1))) Then
  6. ar = Application.Transpose(Application.Transpose(a.Resize(, 4).Value))
  7.    dic(a & a.Offset(, 1)) = ar
  8.    Else
  9. ar = dic(a & a.Offset(, 1))
  10. ar(4) = a.Offset(, 3)
  11.    dic(a & a.Offset(, 1)) = ar
  12. End If
  13. Next
  14. End With
  15. Sheets(2).[A:D].ClearContents
  16. Sheets(2).[A1].Resize(dic.Count, 4) = Application.Transpose(Application.Transpose(dic.items))
  17. End Sub
複製代碼
回復 3# rouber590324
作者: hcm19522    時間: 2018-5-2 10:36

http://blog.xuite.net/hcm19522/twblog/578876886
作者: rouber590324    時間: 2018-5-2 10:38

DEAR  Hsieh  大大
感謝您之指導.100%符合需求  thanks*10000
作者: 准提部林    時間: 2018-5-2 12:46

  1. Sub TEST()
  2. Dim Arr, i&, j%, T$, xD, U&, N&
  3. Arr = Range([Sheet1!D1], [Sheet1!A1].Cells(Rows.Count, 1).End(xlUp))
  4. Set xD = CreateObject("Scripting.Dictionary")
  5. For i = 2 To UBound(Arr)
  6.     T = Arr(i, 1) & Arr(i, 2):  U = xD(T)
  7.     If U = 0 Then
  8.        N = N + 1: xD(T) = N: U = N
  9.        For j = 1 To 4: Arr(U + 1, j) = Arr(i, j): Next
  10.     End If
  11.     Arr(U + 1, 4) = Arr(i, 4)
  12. Next i

  14. Sheets("Sheet2").UsedRange.EntireRow.Delete
  15. Sheets("Sheet2").[A1:D1].Resize(N + 1) = Arr
  16. End Sub
複製代碼
作者: rouber590324    時間: 2018-5-4 11:25

DEAR 准提部林 大大
感謝您之指導.100%符合需求  thanks*10000



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