查看: 6312|回复: 26
请教高手用VBA完成一个考勤表的制作
阅读权限20
在线时间 小时
经过一天的摸索，用函数已经勉强能做出，但运行速度实在太慢，请高手用VBA帮优化完善。万分感谢！
涉及到：不相邻的多列去重复、某一时间段内取时间的最大值/最小值、文本转数值
Snap1.jpg (111.89 KB, 下载次数: 16)
17:21 上传
(37.7 KB, 下载次数: 163)
17:22 上传
点击文件名下载附件
阅读权限100
在线时间 小时
Const swsb = #8:30:00 AM#
Const swxb = #11:59:59 AM#
Const xwsb = #2:00:00 PM#
Const xwxb = #6:00:00 PM#
Sub lqxs()
Dim Arr, i&, swks, swjs, xwks, xwjs, Brr, k1, t1, x$, y
Dim d, k, t, j&, p&, n&, bm, aa
Dim r%, sw(), rr%, xw(), zz, zc, zz1, zc1
Dim cc, cd, zt, qq
Set d = CreateObject(&Scripting.Dictionary&)
ssbyxks = swsb: ssbyxjs = swsb + 0.5 / 24 '上午上班有效考勤记录时间
sxbyxks = swxb - 0.5 / 24: sxbyxjs = swxb + 1 / 24 '上午下班有效考勤记录时间
xsbyxks = xwsb - 1 / 24: xsbyxjs = xwxb + 0.5 / 24 '下午上班有效考勤记录时间
xxbyxks = xwxb - 0.5 / 24: xxbyxjs = xwxb + 0.25&&'下午下班有效考勤记录时间
Sheet2.Activate
[a2:j5000].ClearContents
Arr = Sheet1.[a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 10)
For i = 2 To UBound(Arr)
& & x = Arr(i, 1) & &,& & Arr(i, 3) & &,& & Arr(i, 4): y = Arr(i, 7)
& & If d.exists(x) = False Then Set d(x) = CreateObject(&Scripting.Dictionary&)
& & d(x)(y) = d(x)(y) & Arr(i, 8) & &,&
Next
k = d.keys
t = d.items
For i = 0 To UBound(k)
& & k1 = t(i).keys: t1 = t(i).items
& & For j = 0 To UBound(k1)
& && &&&n = n + 1: r = 0: rr = 0
& && &&&bm = Split(k(i), &,&)
& && &&&Brr(n, 1) = bm(0): Brr(n, 2) = bm(1): Brr(n, 3) = bm(2): Brr(n, 4) = k1(j)
& && &&&t1(j) = Left(t1(j), Len(t1(j)) - 1)
& && &&&If InStr(t1(j), &,&) Then
& && && && &aa = Split(t1(j), &,&)
& && && && &For p = 0 To UBound(aa)
& && && && && & If TimeValue(aa(p)) & xsbyxks Then
& && && && && && &&&r = r + 1
& && && && && && &&&ReDim Preserve sw(1 To r)
& && && && && && &&&sw(r) = TimeValue(aa(p))
& && && && && & Else
& && && && && && &&&rr = rr + 1
& && && && && && &&&ReDim Preserve xw(1 To rr)
& && && && && && &&&xw(rr) = TimeValue(aa(p))
& && && && && & End If
& && && && &Next
& && && && &cc = 0: cd = 0: zt = 0: qq = 0
& && && && &zz = sxbyxks: zc = ssbyxjs
& && && && &For ii = 1 To r
& && && && && & If sw(ii) & zz Then zz = sw(ii)
& && && && && & If sw(ii) & zc Then zc = sw(ii)
& && && && &Next
& && && && &If zz &= swsb + 3 / 1440 Then
& && && && && & cc = 1
& && && && &Else
& && && && && & b = DateDiff(&n&, swks, zz)
& && && && && & If b &= 3 And b &= 10 Then
& && && && && && &&&cd = 1
& && && && && & ElseIf b & 10 Then
& && && && && && &&&qq = 1
& && && && && & End If
& && && && &End If
& && && && &Brr(n, 5) = zz
& && && && &If zc &= swxb - 3 / 1440 Then
& && && && && & cc = 1
& && && && &Else
& && && && && & b = DateDiff(&n&, zc, swxb)
& && && && && & If b &= 3 And b &= 10 Then
& && && && && && &&&zt = 1
& && && && && & ElseIf b & 10 Then
& && && && && && &&&qq = 1
& && && && && & End If
& && && && &End If
& && && && &Brr(n, 6) = zc
& && && && &zz1 = xwxb: zc1 = xwsb
& && && && &For ii = 1 To rr
& && && && && & If xw(ii) & zz1 Then zz1 = xw(ii)
& && && && && & If xw(ii) & zc1 Then zc1 = xw(ii)
& && && && &Next
& && && && &If zz1 &= xwsb + 3 / 1440 Then
& && && && && & cc = 1
& && && && &Else
& && && && && & b = DateDiff(&n&, xwsb, zz1)
& && && && && & If b &= 3 And b &= 10 Then
& && && && && && &&&cd = 1
& && && && && & ElseIf b & 10 Then
& && && && && && &&&qq = 1
& && && && && & End If
& && && && &End If
& && && && &Brr(n, 7) = zz1
& && && && &If zc1 &= xwxb - 3 / 1440 Then
& && && && && & cc = 1
& && && && &Else
& && && && && & b = DateDiff(&n&, zc1, xwxb)
& && && && && & If b &= 3 And b &= 10 Then
& && && && && && &&&zt = 1
& && && && && & ElseIf b & 10 Then
& && && && && && &&&qq = 1
& && && && && & End If
& && && && &End If
& && && && &Brr(n, 8) = zc1
& && && && &Brr(n, 9) = Format(DateDiff(&h&, zz, zc) + DateDiff(&h&, zz1, zc1), &0.0&)
& && && && &If qq = 1 Then
& && && && && & Brr(n, 10) = &缺勤&
& && && && &ElseIf cd = 1 Then
& && && && && & Brr(n, 10) = &迟到&
& && && && &ElseIf zt = 1 Then
& && && && && & Brr(n, 10) = &早退&
& && && && &ElseIf cc = 1 Then
& && && && && & Brr(n, 10) = &正常&
& && && && &End If
& && && && &cc = 0: cd = 0: zt = 0: qq = 0
& && &&&Else
& && && && &Brr(n, 10) = &缺勤&
& && &&&End If
& & Next
Next
[a2].Resize(n, 10) = Brr
End Sub
复制代码
阅读权限100
在线时间 小时
请见附件。
17:56 上传
点击文件名下载附件
77.96 KB, 下载次数: 375
阅读权限20
在线时间 小时
蓝桥玄霜 发表于
请见附件。
先谢谢版主，今天我也用公式摸索了一个，对比了一下，貌似版主的数据漏了几个呢，貌似版主的上午迟到没计算进去
另外，能像公式那样，区分得开“未打卡”和“缺勤”的么？
下图是公式版的，
Snap1.jpg (39.1 KB, 下载次数: 8)
18:24 上传
(105.98 KB, 下载次数: 121)
18:26 上传
点击文件名下载附件
阅读权限20
在线时间 小时
本帖最后由 cubicle 于
18:50 编辑
蓝桥玄霜 发表于
请见附件。
还有一点，像这种不在有效时间段内打卡的，希望是不显示他的考勤记录了，像公式版那样
另外，像3月15日，登记号码为139的那个人，实际考勤明细里面是没有上午的记录的，这个是什么情况？
Snap2.jpg (88.05 KB, 下载次数: 6)
18:45 上传
Snap3.jpg (82.09 KB, 下载次数: 6)
18:45 上传
阅读权限20
在线时间 小时
版主在吗？还请版主帮帮忙，完善一下啦
阅读权限50
在线时间 小时
测试一下，看看如何
14:55 上传
点击文件名下载附件
86.19 KB, 下载次数: 86
阅读权限50
在线时间 小时
你这里还有个问题，就是如职工全天未打卡，则不能报出他缺勤。
阅读权限50
在线时间 小时
改了一下，。。。。。。。。。
15:25 上传
点击文件名下载附件
121.83 KB, 下载次数: 163
阅读权限50
在线时间 小时
& & & & & & & &
你这里好像是，不管是上午或下午，只要有一次缺勤，则算是全天缺勤？
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师制作月考勤表（如何在excel表中插入日历表，我要制造考勤表 只要选择对应月份，日期就自动生成了）-用EXCEL制作的考勤表中，如何按所选年月份自动生成日期？ _汇潮装饰网
您当前位置：
制作月考勤表（如何在excel表中插入日历表，我要制造考勤表 只要选择对应月份，日期就自动生成了）
制作月考勤表（如何在excel表中插入日历表，我要制造考勤表 只要选择对应月份，日期就自动生成了）10分
请问怎么插进去，怎样让它自动生成对应的日子，周末和节假日有颜色的
选择公式，输入=OR(WEEKDAY(A2,2)=6,WEEKDAY(A2，粘贴29行;&quot,1)A3输入公式=IF(MONTH(A2+1)=$A$1,A2+1，点菜单。选择自定义格式&dd&然后设置条件格式选中A2在A1输入月份A2输入公式=DATE(2011,A1,&quot,2)=7);)复制，格式，条件格式
　　excel2007中制作考勤表步骤: 　　1、打开一张空白的EXCEL工作表,先按下图所示画出样...）
( )月份考勤表 姓名 时间1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ...）
考勤表常用函数、公式: 　　1、首先,最基础的就是计算员工当天上班的时间,在C2输入公式=B2-A2...）
如果你使用的是叮咚签到,考勤表直接可以导出来的,不需要刻意去制作。）
Excel用来统计每月的出勤情况,列头是每个月的日期,比如1、2、……、31,行头是每个员工的姓名(...）
下载文件:考勤表.xls|我有一份 自己做的只要输入 年份和月份 其他的 星期几啊 多少天 都是可以...）
B2单元格: =IF(LEFT(A2,1)=&X&, &0&, IF(A2=&&, &&, &10....）
word中有现成的考勤表,可以直接套用,方法如下: 1、打开 2、点击office按钮-&...）月份考勤表_百度文库
两大类热门资源免费畅读
续费一年阅读会员，立省24元！
月份考勤表
北京建造工程师|
总评分4.3|
浏览量14872
用知识赚钱
该文档仅有一页，您已阅读完毕，如需下载请购买
定制HR最喜欢的简历
你可能喜欢
您可以上传图片描述问题
联系电话：
请填写真实有效的信息，以便工作人员联系您，我们为您严格保密。根据月份自动生成日期和星期的考勤表_百度文库
两大类热门资源免费畅读
续费一年阅读会员，立省24元！
根据月份自动生成日期和星期的考勤表
阅读已结束，下载文档到电脑
想免费下载本文？
定制HR最喜欢的简历
你可能喜欢