excel小白的最期，求大神修改下VBA数据

尼曼兔

在excel home 也发了求助贴，不过一直没有什么回应orz是太小白还是太复杂呢？

目前公司用的考勤机功能不太完善，手工整理上百员工的考勤几乎每月都要花一周的时间，看到一个很接近理想的案例
http://club.excelhome.net/forum. ... &tid=800653
那个案例的表格（需启用宏）
  

我自己生搬硬套的失败产品


需要做如下修改：
1.上班时间统一为上午8:30到下午17:00，希望在表中迟到、早退标红底。
2.不需要回避双休日，单纯在表中体现签到的当天最早时间和离开的最晚时间。
3.需要在姓名后加一列进行统计：实际上班天数，以8小时30分为一天，具体到小数点后两位来体现。

原代码

Sub kaoqinfenxi()
Dim RowB, RowA, iRow, iCol, iRQ, jRow, jCol As Integer
Dim sXM, x, y, m, n As String
Dim Rng As Range
    RowA = Sheets("考勤记录").Range("A65536").End(xlUp).Row
    For iRow = 2 To RowA
        x = LTrim(Right(Sheets("考勤记录").Cells(iRow, 2), 8))  '循环读取考勤记录
        y = RTrim(Left(Sheets("考勤记录").Cells(iRow, 2), 10))  '并提取出人名、日期、时间
        sXM = Sheets("考勤记录").Range("A" & iRow)
        With Sheets("考勤表")
            RowB = .Range("A65536").End(xlUp).Row
            Set Rng = .Range("A5:A" & RowB + 2).Find(what:=sXM, LookIn:=xlValues, LookAt:=xlWhole)  '查找要分析的人员所在位置
            If Rng Is Nothing Then                              '判断要分析的人员是否存在于分析表中
                .Range("A2:AG3").Copy Destination:=.Range("A" & RowB + 2)   '如果不存在就新建一条记录
                .Cells(RowB + 2, 1) = sXM                                   '并赋值人名、时间
                .Cells(RowB + 2, Day(y) + 2) = x
            Else: m = .Cells(Rng.Row, Day(y) + 2)                           '如果存在就判断其是最早签到和最后离开时间
                  n = .Cells(Rng.Row + 1, Day(y) + 2)
                  If m = "" Then                                            '如果无数据就肯定是第一次打卡
                    .Cells(Rng.Row, Day(y) + 2) = x
                  ElseIf TimeValue(x) < m Then                              '其实这个判断可不要，因为记录是按时间排序的，如果存在记录肯定就不是第一次了
                        .Cells(Rng.Row, Day(y) + 2) = x
                      ElseIf TimeValue(x) > n Then                          '注意这里的m、n已经被赋值为时间数据格式，因此没必要用TimeValue函数，
                            .Cells(Rng.Row + 1, Day(y) + 2) = x             '而我的记录表中是文本格式，所以x要使用TimeValue来转换。
                  End If
            End If
        End With
    Next
End Sub

尼曼兔

参考表格预览




理想的目标




考勤机中导出的原始数据，有效条目是姓名和考勤时间，不过这个有好几个人都喜欢多次打卡，所以只有靠VBA筛选出每天最早和最晚的考勤时间为有效考勤时间。





不知道附件图片活过来了没- -

赤色彗星SE

嘿嘿好久没玩execel鸟。。。。
已经不想再看vba啦～


这东西原来谁写的叫谁改嘛～

尼曼兔

PM出去了，目前还没有回应，去年做的了orz

赤色彗星SE

周末还没搞定我帮你看看吧

绕指流光

需求1好办，判断上工和下班的条件里各套一个
if timevalue(x)<timevalue("8:30 AM") or timevalue(x)>timevalue("5:00 PM") then
.cell.font.color=RGB (255,0,0)
END IF
.cell的位置自己调整一下

需求2源程序就没涉及……
需求3也好办，循环一下对上下班时间之差求和，再除以timevalue("5:00 PM")-timevalue("8:30 AM")