查看: 4895|回复: 24
请教高手用VBA完成一个考勤表的制作
阅读权限20
在线时间 小时
经过一天的摸索，用函数已经勉强能做出，但运行速度实在太慢，请高手用VBA帮优化完善。万分感谢！
涉及到：不相邻的多列去重复、某一时间段内取时间的最大值/最小值、文本转数值
Snap1.jpg (111.89 KB, 下载次数: 16)
17:21 上传
(37.7 KB, 下载次数: 127)
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, 下载次数: 293
阅读权限20
在线时间 小时
蓝桥玄霜 发表于
请见附件。
先谢谢版主，今天我也用公式摸索了一个，对比了一下，貌似版主的数据漏了几个呢，貌似版主的上午迟到没计算进去
另外，能像公式那样，区分得开“未打卡”和“缺勤”的么？
下图是公式版的，
Snap1.jpg (39.1 KB, 下载次数: 8)
18:24 上传
(105.98 KB, 下载次数: 100)
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, 下载次数: 75
阅读权限50
在线时间 小时
你这里还有个问题，就是如职工全天未打卡，则不能报出他缺勤。
阅读权限50
在线时间 小时
改了一下，。。。。。。。。。
15:25 上传
点击文件名下载附件
121.83 KB, 下载次数: 138
阅读权限50
在线时间 小时
你这里好像是，不管是上午或下午，只要有一次缺勤，则算是全天缺勤？
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师[EXCEL实战技巧精萃]编程篇02-VBA使用进阶_土豆_高清视频在线观看只需一步，快速开始
扫一扫，访问微社区
查看: 545|回复: 6
想入门EXCEL&ACCESS,做个销售出库管理，求VBA高手赐教!!!
想入门EXCEL&ACCESS,做个销售出库管理，求VBA高手赐教!!!
EXCEL实现三个界面（ 附件表SHEET标绿色）：
1、物资信息导入：相当于入库导入，同时导入销售订单信息，其实也就是同时更新二个数据表。
2、出库明细导入：实现有订单不超订单出库，没订单（零星）不超库存出库。
3、查询界面： 根据查询条件查询出数据。
数据表中各表主键请看表设计视图
本帖子中包含更多资源
才可以下载或查看，没有帐号？
这是打算用excel做界面，Access做后台数据库的意思吗？
全部改为Access做应该更容易些吧？
对于excel的用户窗体（UserForm）我不太熟。{:soso_e110:}
这是打算用excel做界面，Access做后台数据库的意思吗？
全部改为Access做应该更容易些吧？
对于excel的用 ...
想用Access做，但不会做导入导出啊，版主能帮我做个吗，我参拜学习下，谢谢了
可使用Access自带的导入功能先把Excel数据导入进来
如果希望经常性导入导出，可搜索本论坛 ： 导入 或 导出，有相关的版主做的示例
可使用Access自带的导入功能先把Excel数据导入进来
如果希望经常性导入导出，可搜索本论坛 ： 导入 或 导 ...
ACCESS代码不会啊
{:soso_e100:}
站长推荐 /6
即日起至日 Office中国全线产品优惠大促销
报名 Access中级 高级 顶级培训 将享有更多优惠，最高优惠达3800元
Access通用开发平台企业版，支持SQLServer后台
优惠价3500元/套
美女MVP教你轻松学习Excel VBA 优惠至88元
Excel O啦插件 优惠至88元
Excel 微信助手 8折优惠
Access超级经典源码剖析 脑图+源码+视频 组合装, 原价2217元,折合优惠价 1280元
更多的优惠请猛戳查看
1.让初学者了解Excel VBA的强大之处，学习VBA的使用
2.使更多Excel使用者会利用VBA来简化工作，减少重复操作
3.让Excel开发者能够快速地使用VBA进行开发设计，做出满足要求的应用
企业中正在实际使用的企业级进销存管理系统
用户可自定义的 拖拉式 流程图设计（而非普通的固死的流程图）
流程清晰 功能齐全 操作方便
VBA开发神器第一版发布-平台插件VBA伴侣
一款VBA编写帮助工具，让你在最短的时间编写质量最高的代码。VBA从此不再害怕！！
1.通用代码库，支持官方代码片段和官方函数
2.快捷添加到个人函数库，方便一键使用
3.函数提交支持参数设置，自动识别过程函数
4.自动生成作者和函数相关，快速填写注释
5.遇到陌生代码，可快速查找
6.代码美化整理
由Office中国出品，让你使用Excel更方便，更高效，更快捷！
搞定工作，不用加班，早点下班不再是梦！
包含功能个数：5大功能模块，近100个Excel功能
Access VBA 开发在线帮助指南手册
1.Access 2010 在线帮助教程手册
2.Access Jet Sql 语法在线帮助
3.微软 API 编程开发手册
4.ADO程序员参考在线帮助手册
5.DAO程序员参考在线帮助手册
6.Access中国在线培训中心
7.Access通用智能开发平台培训教程
8.Excel在线帮助手册大全
Powered byexcel高手用VBA高手来解决excel高手用VBAP112第1_百度知道
excel高手用VBA高手来解决excel高手用VBAP112第1
//c.baidu://c.baidu://c.com/zhidao/wh%3D600%2C800/sign=/zhidao/pic/item/7c1ed21b0ef41bd56febd3cd54da81cb39db3d4a.hiphotos.jpg" esrc="http.jpg" target="_blank" title="点击查看大图" class="ikqb_img_alink"><img class="ikqb_img" src="http./zhidao/wh%3D450%2C600/sign=c58dcff0/7c1ed21b0ef41bd56febd3cd54da81cb39db3d4a<a href="http.hiphotos
提问者采纳
这样？dim a(1 to 10)
提问者评价
来自团队：
其他类似问题
为您推荐：
excel的相关知识
等待您来回答
下载知道APP
随时随地咨询
出门在外也不愁您的举报已经提交成功，我们将尽快处理，谢谢！
光标移到表格左上角的&#034;+&#034;字选取整个表格\然后在EXCEL中直接粘贴就可以了
大家还关注
(window.slotbydup=window.slotbydup || []).push({
id: '2081942',
container: s,
size: '1000,60',
display: 'inlay-fix'