如何能把跨日期下班的时间放在同一天里面

cfull

如何能把跨日期下班的时间放在同一天里面？比如9月1日的夜班，第2天早上下班，

cfull

9月2日实际为1号夜班下班，如何能把放在同一天的日期里面

cfull

顶顶顶，急急急

sunya_0529

1. Option Explicit
   
2. 
   
3. Private Sub CommandButton1_Click()
   
4. Dim cn As Object, sql$, rs As Object
   
5. Dim arr, brr(), i%, j%, k%
   
6. Set cn = CreateObject("ADODB.CONNECTION")
   
7. cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes;IMEX=2';Data Source=" & ThisWorkbook.FullName
   
8. sql = "SELECT 员工姓名,日期,min(时间),max(时间),'' FROM (SELECT 员工姓名,cdate(format(打卡时间,'yyyy-m-d')) AS 日期,cdate(format(打卡时间,'H:M:S')) AS 时间 FROM [Sheet1$A:B]) GROUP BY 员工姓名,日期 ORDER BY 员工姓名,日期"
   
9. Set rs = cn.Execute(sql)
   
10. If Not (rs.EOF Or rs.BOF) Then
    
11.   arr = Application.Transpose(rs.getrows)
    
12.   For i = 1 To UBound(arr)
    
13.     If DateDiff("s", CDate(arr(i, 3)), CDate(arr(i, 4))) < 120 And CDate(arr(i, 3)) > 0.5 And CDate(arr(i, 2)) + 1 = CDate(arr(IIf(i = UBound(arr), UBound(arr), i + 1), 2)) And CDate(arr(IIf(i = UBound(arr), UBound(arr), i + 1), 3)) < 0.5 Then
    
14.       arr(i, 3) = CDate(arr(i, 2)) + CDate(arr(i, 3))
    
15.       arr(i, 4) = CDate(arr(IIf(i = UBound(arr), UBound(arr), i + 1), 2)) + CDate(arr(IIf(i = UBound(arr), UBound(arr), i + 1), 3))
    
16.       arr(i, 5) = "夜班"
    
17.     ElseIf DateDiff("s", CDate(arr(IIf(i = 1, 1, i - 1), 3)), CDate(arr(IIf(i = 1, 1, i - 1), 4))) < 120 And DateDiff("h", CDate(arr(i, 3)), CDate(arr(i, 4))) > 8 Then
    
18.       arr(i, 3) = CDate(arr(i, 2)) + CDate(arr(i, 3))
    
19.       arr(i, 4) = CDate(arr(i, 2)) + CDate(arr(i, 4))
    
20.       arr(i, 5) = "白班"
    
21.     ElseIf DateDiff("h", CDate(arr(i, 3)), CDate(arr(i, 4))) > 8 And arr(IIf(i = 1, 1, i - 1), 5) = "白班" And CDate(arr(IIf(i = 1, 1, i - 1), 2)) + 1 = CDate(arr(i, 2)) Then
    
22.       arr(i, 3) = CDate(arr(i, 2)) + CDate(arr(i, 3))
    
23.       arr(i, 4) = CDate(arr(i, 2)) + CDate(arr(i, 4))
    
24.       arr(i, 5) = "白班"
    
25.     ElseIf DateDiff("h", CDate(arr(i, 3)), CDate(arr(i, 4))) > 8 And arr(IIf(i = 1, 1, i - 1), 5) = "夜班" Then
    
26.       arr(i, 3) = CDate(arr(i, 2)) + CDate(arr(i, 4))
    
27.       arr(i, 4) = CDate(arr(IIf(i = UBound(arr), UBound(arr), i + 1), 2)) + CDate(arr(IIf(i = UBound(arr), UBound(arr), i + 1), 3))
    
28.       arr(i, 5) = "夜班"
    
29.     End If
    
30.   Next i
    
31. End If
    
32. Set rs = Nothing
    
33. Set cn = Nothing
    
34. 
    
35. ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    
36. For i = 1 To UBound(arr, 1)
    
37.   If Len(arr(i, 5)) > 0 Then
    
38.     k = k + 1
    
39.     For j = 1 To UBound(arr, 2)
    
40.       brr(k, j) = arr(i, j)
    
41.     Next j
    
42.   End If
    
43. Next i
    
44. 
    
45. '输出结果
    
46. With ActiveSheet.[E2].Resize(UBound(brr, 1), UBound(brr, 2))
    
47.   .EntireColumn.Clear
    
48.   .Offset(-1, 0) = Array("员工姓名", "日期", "上班时间", "下班时间", "班次")
    
49.   .Cells = brr
    
50. End With
    
51. End Sub

复制代码

都市放牧人

看下是否你想要的结果
放在同一日期里面.zip (19.2 KB, 下载次数: 11)

2023-10-8 09:31 上传

点击文件名下载附件

cfull

sunya_0529 发表于 2023-9-29 14:14

代码运行不了啊

cfull

cfull 发表于 2023-10-9 11:01
代码运行不了啊

2023-09-12 07:36:30

cfull

sunya_0529

cfull 发表于 2023-10-9 11:02
2023-09-12 07:36:30

你的系统和Office版本截图来看一下。

cfull

sunya_0529 发表于 2023-10-15 10:37
你的系统和Office版本截图来看一下。

office 用的wps