[已解决]VBS处理考勤报表（100元有偿）

fcxk

内容与说明在附件“结果表格”

注意：源表格文件名有[]符号，要求处理目录下所有xls表格（现实只有一个表格。但表格名不确定、带有[]符号）
要求日期从 1-31 ，星期一到星期五，排序，删除上班或下班重复打卡时间，提取最前打卡时间为准、

信誉方面：请放心，只要采纳了、百分百支付

aa77dd@163.com（已解决）已经交易

yu2n

楼上，我也做了VBS版本的…

	
		' ' '
		strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _ 
			"`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 06:00:00") & "') And " & _
			"`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 08:15:00") & "')"
		objRS2.Fields("上班1") = StringToDate(RunSQLReturnString(objConn1, strSQL))
		
		strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _ 
			"`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 11:11:00") & "') And " & _
			"`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 12:30:00") & "')"
		objRS2.Fields("下班1") = StringToDate(RunSQLReturnString(objConn1, strSQL))
		
		strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _ 
			"`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 14:00:00") & "') And " & _
			"`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 15:00:00") & "')"
		objRS2.Fields("上班2") = StringToDate(RunSQLReturnString(objConn1, strSQL))
		
		strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _ 
			"`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 16:10:00") & "') And " & _
			"`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 18:10:00") & "')"
		objRS2.Fields("下班2") = StringToDate(RunSQLReturnString(objConn1, strSQL))
		
		strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _ 
			"`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 18:30:00") & "') And " & _
			"`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 19:10:00") & "')"
		objRS2.Fields("上班3") = StringToDate(RunSQLReturnString(objConn1, strSQL))
		
		strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _ 
			"`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 21:00:00") & "') And " & _
			"`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 22:00:00") & "')"
		objRS2.Fields("下班3") = StringToDate(RunSQLReturnString(objConn1, strSQL))
		
		' ' '
复制代码

就想问问，现在还能领红包么…

zyfsky

本人不建议用脚本语言处理，这样大数据的运算，效率太慢了，我可以用VBS的老大，VB程序给你做
效率快N倍，需要VB的，可以联系本人QQ 251838045，
以下提供vbs（部分）代码。
dim a()
set obshell=wscript.createobject("wscript.shell")
xls=obshell.CurrentDirectory & "\源文件.xls"
Set VbExcel1 = CreateObject("Excel.Application") '创建excel对象
   VbExcel1.Visible = False '对象不可见
   VbExcel1.DisplayAlerts = False '关闭时不提示保存
VbExcel1.Workbooks.Open (xls)
VbExcel1.Sheets(1).Select
  Set vbbook1 = VbExcel1
Trows1 = VbExcel1.ActiveSheet.UsedRange.Rows.Count 'Excel表格指定表的总列数带入变量 Trows
   Tcols1 = VbExcel1.ActiveSheet.UsedRange.Columns.Count 'Excel表格指定表的总行数带入变量 Tcols
'msgbox trows1 & " " & tcols1
'以不同员工名定义数组元素
n=0
redim preserve a(n)
a(0)=vbbook1.cells(2,3).value
'循环表格每条数据与新数组的每个元素进行对比判断
for i = 3 to trows1
for j= 0 to ubound(a)
sb=true
'msgbox vbbook1.cells(i,3).value & "," & a(j)
if vbbook1.cells(i,3).value<>a(j) then
sb=true  
else sb=fasle
exit for
end if
next
'若没发现新的数组里，有重名，就增加一人的姓名到新的数组里！
if sb=true then
n=n+1
redim preserve a(n)
a(n)=vbbook1.cells(i,3).value
msgbox n& " " &a(n)
end if
next
'循环列出分别每个人的相关打卡数据
for j= 0 to ubound(a)
msgbox a(j)
for i = 2 to trows1
if vbbook1.cells(i,3).value=a(j) then
ddate=year(vbbook1.cells(i,7).value) & "-" & month(vbbook1.cells(i,7).value) & "-" & day(vbbook1.cells(i,7).value)
msgbox  a(j) & cdate(ddate) & GetWeek(cdate(ddate))
end if
next
next
'显示星期几的函数
Public Function GetWeek(ChkDate)
   GetWeek = WeekdayName(Weekday(ChkDate)) '得知某天星期几
End Function

读取你的源xls
https://shop116026742.taobao.com/，专业程序接单！谢谢！

fcxk

回复 60# aa77dd@163.com


    就按这个可以

fcxk

回复 64# aa77dd@163.com


    就按现在的，不会改了，第一次请您谅解下。

aa77dd@163.com

回复 61# fcxk

你的定义改来改去令人沮丧,  真很沮丧啊     沮丧得我投降了!!!

楼主可知道通常考勤最简易的管理是 人员分班次, 班次时间只取头尾

比如 班次有 早班 [7:00--15:00]  晚班[10:00--18:00]
任何人员都会分配到这两个班次中的一个

而考勤机上每天不管打了多少记录, 只取最早的和最晚的两个记录来计算, 无记录作旷工, 只有一个记录的和班次时间段中心时间点(或别的定义好的时间点)比较后算上班记录或下班记录, 出勤情况需另行核实

这种计算统计方法, 简洁明了, 易操作易实现, 没有模糊不清, 没有自相矛盾

考勤机只是一个辅助手段,  不会有人天天早退还又回去补打考勤, 那样偶尔一次也许蒙混过关, 长期可能吗?

这种一天要 4 次考勤记录的方式很是纠结,  而且没有对人员班次的类型指定, 规则描述复杂繁琐, 很容易错漏矛盾

Demon

乱七八糟

fcxk

回复 60# aa77dd@163.com


    对的，考勤统计是这样

fcxk

回复 60# aa77dd@163.com


    更正上面回答
1.出现下班时间重复的，判断上班是否空，是空的话，提取首个记录为上班，最后一个记录为下班
要是上班存在，则取首个记录为下班

2.上班出现重复的，同理。判断下班是否空，空的话，首个记录为上班，最后一个记录为下班
存在的话，则提取首个记录为上班，删除最后上班记录

aa77dd@163.com

回复 56# fcxk

我再按下面的理解来修改代码

06:00--12:30
14:00--18:10
18:30--22:00

以上三个时间段之外的任何打卡记录视为完全无效记录,  不参与 任何计算 任何统计

按上下班时间划分的同一上班段 的多个记录只计最早的一个
按上下班时间划分的同一下班段 的多个记录: 如果没有对应的上班记录, 则取最晚的一个下班记录, 否则取最早的的一个下班记录


    TLogInB = Array("06:00", "14:00", "18:30")
    TLogInE = Array("08:15", "15:00", "19:10")

    TLogOffB = Array("11:11", "16:10", "21:00")
    TLogOffE = Array("12:30", "18:10", "22:00")
   
不在上述时间点定义的 6 个打卡时间段内的记录, 不参与 考勤段数 计数

523066680

回复 58# aa77dd@163.com


    第三方的一个小程序

aa77dd@163.com

回复 57# 523066680


简单好, 越简单, 越清晰    越复杂, 越可能乱, 乱成一团麻

523066680

回复 49# aa77dd@163.com


    我去做一个简单点的程序，准备发布~

fcxk

回复 55# aa77dd@163.com

   06：00到10：00分为上班时间记录提取： 10：01分到12：30分为下班时间记录提取
   14：00到15：40分为上班时间记录提取：  15：41分到18：10分为下班时间记录提取
   18：30分到20：00分上班时间记录提取：  20：01分到22：00分为下班时间记录提取

比如：打卡时间出现：10：02分、12：00分、记录：上班为空：下班为：12：00分

更正一下：
上班出现重复时：以首次为准：
下班出现重复时：判断上班时间是否为空：要是为空记录提取最后一次下班时间为准：要是上班记录存在，则提取下班首次打卡时间

aa77dd@163.com

回复 54# fcxk

现在的计算机是以精确计算为基础的,  你不能给出精确的定义,  我也不想继续写了

精确的定义并没有多难,  只是所有定义要把所有情况都覆盖到,  而且互相之间不可以矛盾

比如这个时间,  你能不能给出 如果在 几点几分后 算 下班打卡, 否则算上班打卡

代码不是人啊,  不可能懂得  "自然"  的意义的