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

fcxk

回复 60# aa77dd@163.com


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

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

fcxk

回复 60# aa77dd@163.com


    对的，考勤统计是这样

Demon

乱七八糟

aa77dd@163.com

回复 61# fcxk

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

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

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

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

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

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

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

fcxk

回复 64# aa77dd@163.com


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

fcxk

回复 60# aa77dd@163.com


    就按这个可以

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/，专业程序接单！谢谢！

yu2n

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

1.        
   
2.                 ' ' '
   
3.                 strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _
   
4.                         "`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 06:00:00") & "') And " & _
   
5.                         "`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 08:15:00") & "')"
   
6.                 objRS2.Fields("上班1") = StringToDate(RunSQLReturnString(objConn1, strSQL))
   
7.                
   
8.                 strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _
   
9.                         "`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 11:11:00") & "') And " & _
   
10.                         "`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 12:30:00") & "')"
    
11.                 objRS2.Fields("下班1") = StringToDate(RunSQLReturnString(objConn1, strSQL))
    
12.                
    
13.                 strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _
    
14.                         "`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 14:00:00") & "') And " & _
    
15.                         "`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 15:00:00") & "')"
    
16.                 objRS2.Fields("上班2") = StringToDate(RunSQLReturnString(objConn1, strSQL))
    
17.                
    
18.                 strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _
    
19.                         "`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 16:10:00") & "') And " & _
    
20.                         "`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 18:10:00") & "')"
    
21.                 objRS2.Fields("下班2") = StringToDate(RunSQLReturnString(objConn1, strSQL))
    
22.                
    
23.                 strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _
    
24.                         "`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 18:30:00") & "') And " & _
    
25.                         "`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 19:10:00") & "')"
    
26.                 objRS2.Fields("上班3") = StringToDate(RunSQLReturnString(objConn1, strSQL))
    
27.                
    
28.                 strSQL = "Select `打卡时间` From [" & GetFileNameEx(dbSource, "FN") & "] Where `姓名`='" & objRS2.Fields("姓名") & "' And " & _
    
29.                         "`打卡时间`>=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 21:00:00") & "') And " & _
    
30.                         "`打卡时间`<=CDate('" & StringToDate(objRS2.Fields("打卡日期") & " 22:00:00") & "')"
    
31.                 objRS2.Fields("下班3") = StringToDate(RunSQLReturnString(objConn1, strSQL))
    
32.                
    
33.                 ' ' '
    

复制代码

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