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

尼曼兔 发表于 2012-3-15 13:54

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

目前公司用的考勤机功能不太完善，手工整理上百员工的考勤几乎每月都要花一周的时间，看到一个很接近理想的案例
http://club.excelhome.net/forum.php?mod=viewthread&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

尼曼兔 发表于 2012-3-15 13:58

参考表格预览
http://img170.poco.cn/mypoco/myphoto/20120315/14/5242084520120315140617015.gif

理想的目标
http://img170.poco.cn/mypoco/myphoto/20120315/14/5242084520120315140659020.gif

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

http://img170.poco.cn/mypoco/myphoto/20120315/14/5242084520120315140716056.gif

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

赤色彗星SE 发表于 2012-3-15 14:50

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

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

尼曼兔 发表于 2012-3-15 15:09

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

赤色彗星SE 发表于 2012-3-15 15:51

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

绕指流光 发表于 2012-3-15 16:13

需求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")

页: [1]

Stage1st's Archiver

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