统计刷卡考勤结果

excel6687

我公司员工每天刷卡结果保存在“刷卡记录”工作表中，因刷卡记录量较大，需要自动统计每人出勤结果并保存在“考勤结果”工作表中。

在“考勤结果”工作表中横栏为每月日期，竖栏为员工的编号和姓名，需要把“刷卡记录”工作表中每人每天的刷卡记录统计后填写在对应的栏内，“零”、“八”、“四”分别代表零点班、八点班、和四点班，没有刷卡的为空白，零点班的刷卡时间为前一天22:30～24:00，八点班为当天05:00～09:00，四点班为当天14:30～17:00，其余时间刷卡为无效记录。如果某天的两个时间段均有刷卡记录，则都记录在册。

工作簿附后，请各位高手指教在EXCEL2003的环境中如何此项工作，万分感激。

abingooo

请参考：http://club.excelhome.net/thread-835687-1-1.html

蓝桥玄霜

建议做一个结果看看你的统计效果。
没有上班下班的时间界限？也没有迟到早退？

excel6687

零点班的刷卡时间调整为前一天22:30～01:00。我做了一个统计结果示例，这个表格仅仅统计每个员工当班在规定时间内的刷卡次数，迟到、早退等因素可以不考虑，谢谢。

excel6687

abingooo 发表于 2015-2-15 09:14
请参考：http://club.excelhome.net/thread-835687-1-1.html

三年前就有人研究这个问题了！

excel6687

有没有人帮忙看看？

excel6687

有没有人帮忙看看？

autocadr41

excel6687 发表于 2015-2-21 21:37
有没有人帮忙看看？

试试，时间会比较长，不是很理想。
Sub 统计考勤()
ss_s = Timer
Dim arr(1 To 31)

r = Sheets("考勤结果").Range("a65536").End(xlUp).Row
r1 = Sheets("刷卡记录").Range("a65536").End(xlUp).Row
For i = 2 To r
    mycode = Sheets("考勤结果").Cells(i, 1)
    With Worksheets("刷卡记录").Range("a1:a" & r1)
    Set c = .Find(mycode, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            b = c.Offset(0, 2)
            myday = Day(b)
            mytime = CDate(Format$(b, "hh:mm:ss"))

            If (mytime <= CDate("1:00:00") And mytime >= CDate("0:00:00")) Then
                b1 = "零"
                If arr(myday) = "" Then
                    arr(myday) = b1
                Else
                    If arr(myday) Like "*" & b1 & "*" Then
                    Else
                    arr(myday) = arr(myday) & b1
                    End If
                End If
                b1 = ""
            ElseIf mytime <= CDate("23:59:59") And mytime >= CDate("22:30:00") Then
                b1 = "零"
                If arr(myday) = "" Then
                    arr(myday) = b1
                Else
                    If arr(myday) Like "*" & b1 & "*" Then
                    Else
                    arr(myday) = arr(myday) & b1
                    End If
                End If
                b1 = ""
            ElseIf mytime <= CDate("9:00:000") And mytime >= CDate("5:00:000") Then
                b2 = "八"
                If arr(myday) = "" Then
                    arr(myday) = b2
                Else
                    If arr(myday) Like "*" & b2 & "*" Then
                    Else
                    arr(myday) = arr(myday) & b2
                    End If
                End If
                b2 = ""
            ElseIf mytime <= CDate("17:00:000") And mytime >= CDate("14:30:000") Then
                b3 = "四"
                If arr(myday) = "" Then
                    arr(myday) = b3
                Else
                    If arr(myday) Like "*" & b3 & "*" Then
                    Else
                    arr(myday) = arr(myday) & b3
                    End If
                End If
                b3 = ""
            End If
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

Sheets("考勤结果").Cells(i, 4).Resize(1, UBound(arr)) = arr
Erase arr

Next
MsgBox "使用时间 =" & Format(Timer - ss_s, "0.0000s")
End Sub

excel6687

谢了，大过年的让你费心了