记录整理

youyukuku

请大神帮忙完善一下：
如果当天只有一次打卡记录时，整理返回记录时，则上班和下班时间都显示那一条记录。






补充内容 (2024-3-19 14:27):
感谢各位给予的帮助、建议，问题已解决。

LIUZHU

发原始表格附件吧

youyukuku

LIUZHU 发表于 2024-3-14 11:21
发原始表格附件吧

感谢回复 附件已更新

shiruiqiang

姓名和日期做字典，判断字典的数量=1的话，上下班时间取同一条

LIUZHU

这个可以用公式做，vlookup可以取第一个打卡日期，lookup取得最后一个打卡日期，如果打卡日期只有一个，那么取得的结果是一样的

LIUZHU

这原始表格给的也是有意思，给一个2023年的记录，要求统计2024年的打卡结果？

youyukuku

LIUZHU 发表于 2024-3-16 20:33
这原始表格给的也是有意思，给一个2023年的记录，要求统计2024年的打卡结果？

模版，统计时时间不会影响结果。

LIUZHU

用公式吧，简单多了

youyukuku

LIUZHU 发表于 2024-3-18 16:08
用公式吧，简单多了

能否指点一二，🙏

fzxba

1. Sub test0() '未改原来的，个人练习一下，供参考
   
2.   
   
3.   Dim ar(1 To 732, 1 To 200), br, Conn As Object
   
4.   Dim strConn As String, SQL As String, stComp As String
   
5.   Dim idx As Long, cnt As Long
   
6.   Dim posCol As Long, posRow As Long
   
7.   
   
8.   With Sheet2
   
9.     .Activate
   
10.     .UsedRange.Offset(1, 1).ClearContents
    
11.   End With
    
12.   
    
13.   Application.ScreenUpdating = False
    
14.   Application.Calculation = xlCalculationManual
    
15.   
    
16.   Set Conn = CreateObject("ADODB.Connection")
    
17.   
    
18.   If Application.Version < 12 Then
    
19.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=YES';Data Source="
    
20.   Else
    
21.     strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=YES';Data Source="
    
22.   End If
    
23.   Conn.Open strConn & ThisWorkbook.FullName
    
24.   
    
25.   SQL = "SELECT 工号,姓名,DATEVALUE(日期) AS 日期,MIN(CDATE(日期)) AS MinTime,MAX(CDATE(日期)) AS MaxTime FROM [打卡记录$] WHERE LEN(日期) GROUP BY 工号,姓名,DATEVALUE(日期)"
    
26.   br = Conn.Execute(SQL).GetRows
    
27.   
    
28.   For idx = 0 To UBound(br, 2)
    
29.     posRow = Day(br(2, idx)) * 2 + 1
    
30.     If stComp <> br(0, idx) & br(1, idx) Then
    
31.       cnt = cnt + 1
    
32.       posCol = cnt * 2 - 1
    
33.       stComp = br(0, idx) & br(1, idx)
    
34.       ar(1, posCol) = br(0, idx)
    
35.       ar(2, posCol) = br(1, idx)
    
36.     End If
    
37.     ar(posRow, posCol) = br(3, idx)
    
38.     ar(posRow + 1, posCol) = br(4, idx)
    
39.   Next
    
40.   
    
41.   Range("B2").Resize(posRow + 1, cnt * 2) = ar
    
42.   
    
43.   Conn.Close
    
44.   Set Conn = Nothing
    
45.   
    
46.   Application.Calculation = xlCalculationAutomatic
    
47.   Application.ScreenUpdating = True
    
48.   Beep
    
49. End Sub

复制代码