[已解决]求助考勤数据加工

lujianwkx

各位大虾：
      我们公司员工进出都需要打卡，考勤数据一天会有很多次，每次需人工逐笔分析是否迟到早退。现希望帮我用宏或公式实现
1.只显示每位员工每天的第一次和最后一次的考勤记录
2.想实现自动统计每位员工当月第一次打卡在上午9：30分之后的次数和最后一次打卡在19：30分的数据以便考核分析
可以在另个表页显示即可。数据请看附件。
比较急请帮忙，谢谢

最佳答案

月排行榜 / 总排行榜

grf1973

2015-3-26 13:55

1. Sub 考勤()
   
2.     Dim Arr, Dic, Rq, Tm, Str$, Tm1, Tm2, Dicrt()
   
3.     Set Dic = CreateObject("Scripting.Dictionary")
   
4.     Arr = [a1].CurrentRegion
   
5.     ReDim Dicrt(1 To UBound(Arr), 1 To 5)      '每天第一次和最末次打卡情况
   
6.     Columns("f:q").ClearContents
   
7.     For i = 2 To UBound(Arr)
   
8.         Rq = Format(Arr(i, 3), "yyyy-mm-dd")
   
9.         Tm = Format(Arr(i, 3), "hh:mm:ss")
   
10.         Str = Arr(i, 1) & "*" & Arr(i, 2) & "*" & Rq
    
11.         c = IIf(Tm < #1:00:00 PM#, 4, 5)
    
12.         If Not Dic.exists(Str) Then
    
13.             n = n + 1
    
14.             Dic(Str) = n
    
15.             Dicrt(n, 1) = Arr(i, 1)
    
16.             Dicrt(n, 2) = Arr(i, 2)
    
17.             Dicrt(n, 3) = Rq
    
18.             Dicrt(n, c) = Tm
    
19.         Else
    
20.             If c = 5 Then Dicrt(Dic(Str), c) = Tm
    
21.         End If
    
22.     Next
    
23.     [f1].Resize(1, 5) = Array("部门", "姓名", "打卡时间", "第一次打卡", "最未次打卡")
    
24.     [f2].Resize(n, 5) = Dicrt
    
25.    
    
26.     ReDim brr(1 To UBound(Dicrt), 1 To 6)      '迟到、早退、未打卡情况
    
27.     For i = 1 To n
    
28.         Tm1 = Dicrt(i, 4): Tm2 = Dicrt(i, 5)
    
29.         Str = Dicrt(i, 1) & "*" & Dicrt(i, 2)
    
30.         If Not Dic.exists(Str) Then
    
31.             m = m + 1
    
32.             Dic(Str) = m
    
33.             brr(m, 1) = Dicrt(i, 1)
    
34.             brr(m, 2) = Dicrt(i, 2)
    
35.         End If
    
36.         p = Dic(Str)
    
37.         If Len(Tm1) = 0 Then brr(p, 5) = brr(p, 5) + 1 Else If Tm1 < #9:30:00 AM# Then brr(p, 3) = brr(p, 3) + 1
    
38.         If Len(Tm2) = 0 Then brr(p, 6) = brr(p, 6) + 1 Else If Tm2 > #7:30:00 PM# Then brr(p, 4) = brr(p, 4) + 1
    
39.     Next
    
40.     [L1].Resize(1, 6) = Array("部门", "姓名", "迟到", "早退", "上班未打卡", "下班未打卡")
    
41.     [L2].Resize(m, 6) = brr
    
42. End Sub
    

复制代码

跳转到最佳答案楼层

tgydslr

你希望显示成什么样式？附件再说明些

lmze2000

1. Sub 考勤()
   
2.     Dim Arr, Dic, Rq, Tm, Str$
   
3.     Set Dic = CreateObject("Scripting.Dictionary")
   
4.     Arr = [a1].CurrentRegion
   
5.     Columns("f:j").ClearContents
   
6.     For i = 2 To UBound(Arr)
   
7.         Rq = Format(Arr(i, 3), "yyyy-mm-dd")
   
8.         Tm = Format(Arr(i, 3), "hh:mm:ss")
   
9.         Str = Arr(i, 1) & "*" & Arr(i, 2) & "*" & Rq
   
10.         Dic(Str) = Dic(Str) & "*" & Tm
    
11.     Next
    
12.     bt = Array("部门", "姓名", "打卡时间", "第一次打卡", "最未次打卡")
    
13.     ReDim dicrt(Dic.Count, 1 To 5)
    
14.     For i = 0 To Dic.Count - 1
    
15.         Str = Dic.keys()(i)
    
16.         Tm = Split(Dic.items()(i), "*")
    
17.         If Tm(1) < #9:30:00 AM# And Tm(UBound(Tm)) > #7:30:00 PM# Then
    
18.             js = js + 1
    
19.             dicrt(js, 1) = Split(Str, "*")(0)
    
20.             dicrt(js, 2) = Split(Str, "*")(1)
    
21.             dicrt(js, 3) = Split(Str, "*")(2)
    
22.             dicrt(js, 4) = Tm(1)
    
23.             dicrt(js, 5) = Tm(UBound(Tm))
    
24.         End If
    
25.     Next
    
26.     [f1].Resize(js, 5) = dicrt
    
27.     [f1].Resize(1, 5) = bt
    
28. End Sub
    

复制代码

不知道你要求的是不是这样的，你看一下。

考勤.zip (310.31 KB, 下载次数: 34)

2015-3-25 23:53 上传

点击文件名下载附件

lujianwkx

lmze2000 发表于 2015-3-25 23:54
不知道你要求的是不是这样的，你看一下。

是要这个结果。但报表数据不全，比如邓丽君1号，4号，5号，每天都有数据但用了宏只有12号一天的。请帮忙修改完善一下。谢谢。我不会修改。

lmze2000

lujianwkx 发表于 2015-3-26 11:16
是要这个结果。但报表数据不全，比如邓丽君1号，4号，5号，每天都有数据但用了宏只有12号一天的。请帮忙修 ...

那个是有数据，根据你的要求是保留了9:30分以前的和19:30分之后的，如果你想全保留，，就要把if判断的那个去掉就可以了。

1. 
   
2. Sub 考勤()
   
3.     Dim Arr, Dic, Rq, Tm, Str$
   
4.     Set Dic = CreateObject("Scripting.Dictionary")
   
5.     Arr = [a1].CurrentRegion
   
6.     Columns("f:j").ClearContents
   
7.     For i = 2 To UBound(Arr)
   
8.         Rq = Format(Arr(i, 3), "yyyy-mm-dd")
   
9.         Tm = Format(Arr(i, 3), "hh:mm:ss")
   
10.         Str = Arr(i, 1) & "*" & Arr(i, 2) & "*" & Rq
    
11.         Dic(Str) = Dic(Str) & "*" & Tm
    
12.     Next
    
13.     bt = Array("部门", "姓名", "打卡时间", "第一次打卡", "最未次打卡")
    
14.     ReDim dicrt(Dic.Count, 1 To 5)
    
15.     For i = 0 To Dic.Count - 1
    
16.         Str = Dic.keys()(i)
    
17.         Tm = Split(Dic.items()(i), "*")
    
18.             js = js + 1
    
19.             dicrt(js, 1) = Split(Str, "*")(0)
    
20.             dicrt(js, 2) = Split(Str, "*")(1)
    
21.             dicrt(js, 3) = Split(Str, "*")(2)
    
22.             dicrt(js, 4) = Tm(1)
    
23.             dicrt(js, 5) = Tm(UBound(Tm))
    
24.     Next
    
25.     [f1].Resize(js, 5) = dicrt
    
26.     [f1].Resize(1, 5) = bt
    
27. End Sub

复制代码

grf1973

1. Sub 考勤()
   
2.     Dim Arr, Dic, Rq, Tm, Str$, Tm1, Tm2, Dicrt()
   
3.     Set Dic = CreateObject("Scripting.Dictionary")
   
4.     Arr = [a1].CurrentRegion
   
5.     ReDim Dicrt(1 To UBound(Arr), 1 To 5)      '每天第一次和最末次打卡情况
   
6.     Columns("f:q").ClearContents
   
7.     For i = 2 To UBound(Arr)
   
8.         Rq = Format(Arr(i, 3), "yyyy-mm-dd")
   
9.         Tm = Format(Arr(i, 3), "hh:mm:ss")
   
10.         Str = Arr(i, 1) & "*" & Arr(i, 2) & "*" & Rq
    
11.         c = IIf(Tm < #1:00:00 PM#, 4, 5)
    
12.         If Not Dic.exists(Str) Then
    
13.             n = n + 1
    
14.             Dic(Str) = n
    
15.             Dicrt(n, 1) = Arr(i, 1)
    
16.             Dicrt(n, 2) = Arr(i, 2)
    
17.             Dicrt(n, 3) = Rq
    
18.             Dicrt(n, c) = Tm
    
19.         Else
    
20.             If c = 5 Then Dicrt(Dic(Str), c) = Tm
    
21.         End If
    
22.     Next
    
23.     [f1].Resize(1, 5) = Array("部门", "姓名", "打卡时间", "第一次打卡", "最未次打卡")
    
24.     [f2].Resize(n, 5) = Dicrt
    
25.    
    
26.     ReDim brr(1 To UBound(Dicrt), 1 To 6)      '迟到、早退、未打卡情况
    
27.     For i = 1 To n
    
28.         Tm1 = Dicrt(i, 4): Tm2 = Dicrt(i, 5)
    
29.         Str = Dicrt(i, 1) & "*" & Dicrt(i, 2)
    
30.         If Not Dic.exists(Str) Then
    
31.             m = m + 1
    
32.             Dic(Str) = m
    
33.             brr(m, 1) = Dicrt(i, 1)
    
34.             brr(m, 2) = Dicrt(i, 2)
    
35.         End If
    
36.         p = Dic(Str)
    
37.         If Len(Tm1) = 0 Then brr(p, 5) = brr(p, 5) + 1 Else If Tm1 < #9:30:00 AM# Then brr(p, 3) = brr(p, 3) + 1
    
38.         If Len(Tm2) = 0 Then brr(p, 6) = brr(p, 6) + 1 Else If Tm2 > #7:30:00 PM# Then brr(p, 4) = brr(p, 4) + 1
    
39.     Next
    
40.     [L1].Resize(1, 6) = Array("部门", "姓名", "迟到", "早退", "上班未打卡", "下班未打卡")
    
41.     [L2].Resize(m, 6) = brr
    
42. End Sub
    

复制代码

grf1973

且慢，迟到早退统计错了，应该是9.30后算迟到，计算了9.30前的。。。。。。
改正下。。。。。。。

teddyjin1984

grf1973 发表于 2015-3-26 15:36
且慢，迟到早退统计错了，应该是9.30后算迟到，计算了9.30前的。。。。。。
改正下。。。。。。。

大侠，可以不可以帮忙用同样的数据，再增加一些内容呢呢，我们公司上午要打2次卡，下午也要打2次卡，然后晚上加班又要打2次卡，相当于如有有加班的话，要打6次卡，上午是8：00-11：30，然后午休1小时，下午上班12：30-17：00，晚上加班时间是17：30后，加班已打卡时间为准，上午8：05分以内打卡不算迟到，下午16：55分以后打卡不算早退，未打卡计漏打开，谢谢大神帮忙下。

风摆渡

大侠，如果有员工某天一次卡都没有打，怎么体现出来啊？