[已解决]统计考勤求助

zhaojunqiu

附件是我们单位考勤机的记录，我们的考勤规则是，早晨8:00前签到及9:00后签退算是有效出勤。如何用宏统计出每个人的有效出勤次数。万分感谢！以下是我写的，没能实现！
Sub Macro1()
Dim row_number, column_number, Insert_Column, Work_Name, Work_Number As Integer
Dim morning, night As String

row_number = Range("a65536").End(xlUp).Row
column_number = Range("IV1").End(xlToLeft).Column
Insert_Column = 10 '初始化插入列数


    For i = 1 To 2
        For k = 1 To 2
            If Cells(1, k + 2) = i Then
            
               For s = 1 To Insert_Column
                   Columns(k + 3).Insert Shift:=xlShiftToRight '插入1列
               Next s
            
               Columns(k + 2).Select
               Selection.TextToColumns Destination:=Cells(1, k + 2), DataType:=xlDelimited, _
                         TextQualifier:=xlNone, Space:=True, OtherChar:=" ", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
               Cells.Select
               Selection.Replace What:="AM", Replacement:=""
               Selection.Replace What:="PM", Replacement:=""
               
               For n = 2 To row_number
               
                   For m = 1 To Insert_Column  '判断有没有8点前签到
                       If Hour(Cells(n, m + 2).Value) < 8 And Cells(n, m + 2).Value <> "" Then
                          morning = "Yes"
                          Else: morning = ""
                       End If
                   Next m
               
                   For m = 1 To Insert_Column '判断有没有9点后签到
                       If Hour(Cells(n, m + 2).Value) >= 9 And Cells(n, m + 2).Value <> "" Then
                          night = "Yes"
                          Else: night = ""
                       End If
                   Next m
                   Cells(1, 1) = Hour(Cells(n, m + 2).Value)
                   If morning = "Yes" And night = "Yes" Then
                            Cells(n, k + 2) = "是"
                      Else: Cells(n, k + 2) = ""
                   End If
                  
               Next n
             End If
             For s = 1 To Insert_Column
                 Columns(k + 3).Delete
             Next s
        Next k
    Next i
End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2016-3-15 16:47

1. Sub tt()
   
2.     t1 = TimeValue("8:00")
   
3.     t2 = TimeValue("9:00")
   
4.     arr = Sheet1.[a1].CurrentRegion.Offset(1)
   
5.     ReDim brr(1 To UBound(arr), 1 To 3)
   
6.     For i = 1 To UBound(arr)
   
7.         brr(i, 1) = arr(i, 1)
   
8.         brr(i, 2) = arr(i, 2)
   
9.         For j = 3 To UBound(arr, 2)
   
10.             x = Trim(arr(i, j))
    
11.             If InStr(x, " ") > 0 Then
    
12.                 xrr = Split(x, " ")
    
13.                 xfirst = TimeValue(xrr(0))
    
14.                 xlast = TimeValue(xrr(UBound(xrr)))
    
15.                 If xfirst <= t1 And xlast >= t2 Then brr(i, 3) = brr(i, 3) + 1
    
16.             End If
    
17.         Next
    
18.     Next
    
19.     With Sheet2
    
20.         .[a1].Resize(1, 3) = Array("工号", "姓名", "有效出勤")
    
21.         .[a2].Resize(i - 1, 3) = brr
    
22.     End With
    
23. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     t1 = TimeValue("8:00")
   
3.     t2 = TimeValue("9:00")
   
4.     arr = Sheet1.[a1].CurrentRegion.Offset(1)
   
5.     ReDim brr(1 To UBound(arr), 1 To 3)
   
6.     For i = 1 To UBound(arr)
   
7.         brr(i, 1) = arr(i, 1)
   
8.         brr(i, 2) = arr(i, 2)
   
9.         For j = 3 To UBound(arr, 2)
   
10.             x = Trim(arr(i, j))
    
11.             If InStr(x, " ") > 0 Then
    
12.                 xrr = Split(x, " ")
    
13.                 xfirst = TimeValue(xrr(0))
    
14.                 xlast = TimeValue(xrr(UBound(xrr)))
    
15.                 If xfirst <= t1 And xlast >= t2 Then brr(i, 3) = brr(i, 3) + 1
    
16.             End If
    
17.         Next
    
18.     Next
    
19.     With Sheet2
    
20.         .[a1].Resize(1, 3) = Array("工号", "姓名", "有效出勤")
    
21.         .[a2].Resize(i - 1, 3) = brr
    
22.     End With
    
23. End Sub
    

复制代码

zhaojunqiu

grf1973 发表于 2016-3-15 16:47

你好，这个宏可以运行并得到我想要的结果。只是能不能让它不是按钮而是用保存在个人工作簿的宏运行在新建表中标注，这样就可以得到每一个人在哪一天是有效出勤的明细。

grf1973

不懂你的意思

zhaojunqiu

grf1973 发表于 2016-3-15 22:16
不懂你的意思

两个表，宏处理完得到Sheet1的格式。另外就是我想把宏保存到个人工作簿中，但是您这个运行的时候会报错。