关于考勤统计的问题vba

ccsc006

规则：上班时间8点45之前打卡

下班17：00 之后打卡

找出异常的记录

1、迟到早退的打卡记录

2、当天早上或下班没有打卡的记录

异常记录提取出来放在一个新表里

谢谢各位帮忙。

chentonny

先判断姓名，再判断日期，接着判断时间，最后输出结果。

ccsc006

迟到早退问题可以判断出来了。
现在的问题是如何判断漏打卡。我建立了个数组比如叫aa1 ，如果数组的值有1和4就说明没有漏打卡，否则要标记出来。
请教各位，如何做个循环判断出这个数组没有1或4呢。谢谢啦

魂断蓝桥

例子.rar (17.36 KB, 下载次数: 2)

2019-2-13 13:03 上传

点击文件名下载附件

Option Explicit

Sub a()
Dim cnn As New cConnection
Dim rs As New cRecordset
Dim sql$, arr, i%, R%
R = Sheet1.[B9999].End(3).Row
arr = Sheet1.Range("A1:E" & R)
cnn.CreateNewDB ":memory:"
sql = "create table T1 (姓名,日期,打卡时间)"
cnn.Execute sql
cnn.BeginTrans
For i = 2 To UBound(arr)
    sql = "INSERT INTO T1 VALUES('" _
        & arr(i, 2) & "','" & arr(i, 4) & "','" & Format(arr(i, 5), "HH:MM:SS") & "')"
    cnn.Execute sql
Next
cnn.CommitTrans
Sheet2.Activate
Cells.Clear
sql = "select 姓名,日期,打卡时间," _
        & "CASE WHEN SUBSTR(打卡时间,1,8)=SUBSTR(打卡时间,10,8) THEN  '缺打卡时间'" _
        & " WHEN SUBSTR(打卡时间,1,8)>'08:45:00' AND SUBSTR(打卡时间,10,8)>'17:00:00' THEN  '迟到'" _
        & " WHEN SUBSTR(打卡时间,1,8)<'08:45:00' AND SUBSTR(打卡时间,10,8)<'17:00:00' THEN  '早退'" _
        & " WHEN SUBSTR(打卡时间,1,8)>'08:45:00' AND SUBSTR(打卡时间,10,8)<'17:00:00' THEN  '迟到&早退' end As 异常" _
         & " from (SELECT 姓名,日期,MIN(打卡时间)||'|'||MAX(打卡时间) AS 打卡时间 from T1 GROUP BY 姓名,日期)" _
        & " where 异常 is not null"
rs.OpenRecordset sql, cnn
Range("A2").CopyFromRecordset rs.GetADORsFromContent
Cells.Font.Size = 12
Set cnn = Nothing
Set rs = Nothing
End Sub

魂断蓝桥

代码审核中，先传个附件

如果符合你的要求，按我签名档下载两个控件，因为用到了内存数据库 sqlite



例子.rar (17.36 KB, 下载次数: 8)

2019-2-13 13:05 上传

点击文件名下载附件

ccsc006

谢谢我研究研究，感谢。

mzbao

1. Sub test()
   
2.     Dim d, arr(), temp, temp1, tempArr(), brr(), i%, j%, sName$, dDate As Date
   
3.    
   
4. '    On Error Resume Next
   
5.     With ThisWorkbook.Worksheets("考勤")
   
6.         arr = .Range("A13:B" & .Cells(Rows.Count, 1).End(xlUp).row).Value
   
7.     End With
   
8.    
   
9.     Set d = CreateObject("Scripting.Dictionary")
   
10.     For i = 1 To UBound(arr)
    
11.         sName = arr(i, 1)
    
12.         dDate = DateValue(arr(i, 2))
    
13.         If TimeValue(arr(i, 2)) < #2:00:00 AM# Then dDate = dDate - 1
    
14.         d(sName & "@" & dDate) = d(sName & "@" & dDate) & "," & arr(i, 2)
    
15.     Next
    
16.     If d.Count = 0 Then Exit Sub
    
17.     temp = d.keys
    
18. '    Debug.Print d.Count, UBound(temp)
    
19.     ReDim tempArr(1 To d.Count, 1 To 10)
    
20.     For i = 0 To UBound(temp)
    
21.         tempArr(i + 1, 1) = temp(i)
    
22.         temp1 = Split(d(temp(i)), ",")
    
23.         For j = 1 To UBound(temp1)
    
24.             tempArr(i + 1, j + 1) = temp1(j)
    
25.         Next
    
26.     Next
    
27.    
    
28.     Dim rArr(), k%, txt$, n%, nTxt$
    
29.     ReDim rArr(1 To 1)
    
30.     For i = 1 To UBound(tempArr)
    
31.         txt = "": nTxt = ""
    
32.         For j = 2 To UBound(tempArr, 2)
    
33.             If tempArr(i, j) = 0 Then Exit For
    
34.             n = sd(TimeValue(tempArr(i, j)))
    
35.             nTxt = nTxt & "," & n
    
36.             If n = 2 Then txt = txt & "," & "迟到[" & TimeValue(tempArr(i, j)) & "]"
    
37.             If n = 3 Then txt = txt & "," & "早退[" & TimeValue(tempArr(i, j)) & "]"
    
38.         Next j
    
39.         If InStr(nTxt, 2) = 0 And InStr(nTxt, 1) = 0 Then txt = txt & "," & "上班未打卡"
    
40.         If InStr(nTxt, 3) = 0 And InStr(nTxt, 4) = 0 Then txt = txt & "," & "下班未打卡"
    
41.         
    
42.         If Len(txt) Then
    
43.             k = k + 1
    
44.             ReDim Preserve rArr(1 To k)
    
45.             rArr(k) = tempArr(i, 1) & txt
    
46.         End If
    
47.     Next i
    
48.     ThisWorkbook.Worksheets("Sheet1").Range("A2").Resize(k) = Application.Transpose(rArr)
    
49. End Sub
    
50. 
    
51. Function sd(sj As Date)
    
52.     Select Case sj
    
53.         Case #12:00:00 AM# To #2:00:00 AM#
    
54.             sd = 4
    
55.         Case #2:01:00 AM# To #8:45:00 AM#
    
56.             sd = 1
    
57.         Case #8:45:01 AM# To #11:59:59 AM#
    
58.             sd = 2
    
59.         Case #12:00:00 PM# To #4:59:59 PM#
    
60.             sd = 3
    
61.         Case #5:00:00 PM# To #11:59:59 PM#
    
62.             sd = 4
    
63.     End Select
    
64. End Function
    

复制代码

ccsc006

这个也厉害。感谢感谢