返回列表 上一主題 發帖

[發問] 上班時間問題請教

[發問] 上班時間問題請教

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

請上傳檔案~~才好參考
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

DER  准提部林  大大
1.公司電腦,限制無法上傳檔案與下載檔案.
   故方用文字書寫.尚請見諒.SORRY*10000

TOP

  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
學海無涯_不恥下問

TOP

隨意窩 "EXCEL迷"  blog  或 http://blog.xuite.net/hcm19522/twblog
已收集4100篇 EXCEL函數

TOP

DEAR  Hsieh  大大
感謝您之指導.100%符合需求  thanks*10000

TOP

  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

  13. Sheets("Sheet2").UsedRange.EntireRow.Delete
  14. Sheets("Sheet2").[A1:D1].Resize(N + 1) = Arr
  15. End Sub
複製代碼
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

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

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題