打卡时间条件的考勤判断

329397900

LIUZHU 发表于 2014-6-27 16:54
附件在此，请审核

判断生成区域 没有数据生成，我哪里出错了吗

LIUZHU

329397900 发表于 2014-6-27 17:02
判断生成区域 没有数据生成，我哪里出错了吗

==，数据不对，要修改

LIUZHU

现在运行的结果都是“不符合”

329397900

LIUZHU 发表于 2014-6-27 17:08
现在运行的结果都是“不符合”

我刚看了下原始数据，就拿编号14的人来说，第2481行和第2869行就是符合的

LIUZHU

329397900 发表于 2014-6-27 17:16
我刚看了下原始数据，就拿编号14的人来说，第2481行和第2869行就是符合的

修改了一下代码，请参考

1. Private Sub CommandButton1_Click()
   
2.     Dim r&, c%, i%, j%
   
3.     Dim Arr(), Brr(), Crr()
   
4.     Dim Dic1 As New Dictionary
   
5.    
   
6.     With Sheets("打卡机记录")
   
7.         .AutoFilterMode = False
   
8.         r = .Range("A" & .Rows.Count).End(xlUp).Row
   
9.         Crr = .Range("A1:C" & r).Value
   
10.         .Range("A1:C" & r).Sort key1:=.Range("B1"), key2:=.Range("C1")
    
11.         Arr = .Range("A1:C" & r).Value
    
12.         .Range("A1:C" & r).Value = Crr          '还原成排序前的状态
    
13.     End With
    
14.       
    
15.     For i = 1 To UBound(Arr)
    
16.         If Not Dic1.Exists(Arr(i, 2) & "%" & Format(Arr(i, 3), "yyyy-m-d")) Then
    
17.             ReDim Brr(1 To 3)
    
18.             Brr(3) = "不符合"
    
19.             Dic1(Arr(i, 2) & "%" & Format(Arr(i, 3), "yyyy-m-d")) = Brr         '存入
    
20.         End If
    
21.         
    
22.         Brr = Dic1(Arr(i, 2) & "%" & Format(Arr(i, 3), "yyyy-m-d"))         '提取
    
23.         If Brr(3) = "符合" Then GoTo 100            '已经“符合”的打卡数据不再判断
    
24.         
    
25.         If Format(Arr(i, 3), "hh:mm:ss") <= "08:00:00" Then
    
26.             Brr(1) = 1
    
27.         ElseIf (Format(Arr(i, 3), "hh:mm:ss") > "12:00:00") * (Format(Arr(i, 3), "hh:mm:ss") <= "14:00:00") Then
    
28.             Brr(2) = 1
    
29.         End If
    
30.         
    
31.         If Brr(1) * Brr(2) Then Brr(3) = "符合"
    
32.         Dic1(Arr(i, 2) & "%" & Format(Arr(i, 3), "yyyy-m-d")) = Brr         '更新打卡符合记录
    
33. 100:
    
34.     Next
    
35.    
    
36.     '将打卡记录写入表中
    
37.     r = Cells(Rows.Count, 1).End(xlUp).Row
    
38.     c = Cells(1, Columns.Count).End(xlToLeft).Column
    
39.     Range("B2").Resize(r - 1, c - 1).ClearContents
    
40.     Arr = Range("A1").Resize(r, c).Value
    
41.    
    
42.     For i = 2 To UBound(Arr)
    
43.         For j = 2 To UBound(Arr, 2)
    
44.             If Dic1.Exists(Arr(1, j) & "%" & Arr(i, 1)) Then
    
45.                 Arr(i, j) = Dic1(Arr(1, j) & "%" & Arr(i, 1))(3)
    
46.             End If
    
47.         Next
    
48.     Next
    
49.     Range("A1").Resize(r, c).Value = Arr            '回写
    
50. End Sub

复制代码

LIUZHU

修改后的附件，请重新查看结果

329397900

LIUZHU 发表于 2014-6-27 17:19
修改了一下代码，请参考

还是没数据生成

LIUZHU

329397900 发表于 2014-6-27 17:22
还是没数据生成

你是用我上载的附件测试吗？

329397900

LIUZHU 发表于 2014-6-27 17:25
你是用我上载的附件测试吗？

恩，空白的

LIUZHU

329397900 发表于 2014-6-27 17:26
恩，空白的

请问您点击了“打卡符合判断"按钮了吗？另请明确是否已启用宏？