下面是根据从考勤机上面下载的数据计算考勤的代码，感觉运行速度很慢，各位老大看看能怎么优化一下，谢谢！
人员表
| 编号 | 姓名 | 密码 | 权限 | 启用 | 部门 |
| 1 | 张三 | | 0 | TRUE | 后勤部 |
| 2 | 李四 | | 0 | FALSE | 后勤部 |
采集数据表
| 姓名 | 编号 | 时间 | 机器 | 方式 | IP | Y | M | D | T | 方法 |
| 张三 | 1 | 2019-01-02 08:04:45 | 1 | 1 | 192.168.1.245 | 2019 | 1 | 2 | 08:04:45 | 采集 |
| 张三 | 1 | 2019-01-02 17:08:56 | 1 | 1 | 192.168.1.245 | 2019 | 1 | 2 | 17:08:56 | 采集 |
| 李四 | 2 | 2019-01-03 17:08:51 | 1 | 1 | 192.168.1.245 | 2019 | 1 | 3 | 17:08:51 | 采集 |
| | | | | | | | | | |
考勤表
| 编号 | 姓名 | Y | M | D | 时间 | 考勤 | 迟到次 | 早退次 | 请假 | 出差 | 加班 |
| 1 | 张三 | 2019 | 1 | 2 | 08:04:45|17:08:56 | 480 | 0 | 0 | 0 | 0 | 0 |
| 2 | 李四 | 2019 | 1 | 3 | 17:08:51 | 0 | 0 | 0 | 0 | 0 | 0 |
| | | | | | | | | | | |
Dim ts As Integer = args(0) * -1
Dim dk,dr,nr As DataRow
Dim Filter,sj As String
Dim dy As Date = Date.Today
Dim mk,nk,ek,mc,ez,nc,mz As Boolean
DataTables("机器").load
DataTables("人员").load
DataTables("采集数据").load
DataTables("考勤").load
Dim drs,dks As List(Of DataRow)
drs = DataTables("人员").Select("启用 = 1")
If drs.Count >= 1 And ts <= -1 Then
DataTables("采集数据").StopRedraw
For Each r As DataRow In drs
For i As Integer = ts To -1
Filter = "编号 = '" & r("编号") & "' and Y = '" & dy.AddDays(i).Year & "' And M = '" & dy.AddDays(i).Month & "' And D = '" & dy.AddDays(i).Day & "'"
dr = DataTables("采集数据").Find(Filter)
dks = DataTables("采集数据").Select(Filter)
dk = DataTables("考勤").Find(Filter)
sj = DataTables("采集数据").GetComboListString("T",Filter & " And T Is not null")
If sj.Contains("1900-01-01 ") Then
sj = sj.Replace("1900-01-01 ","")
ElseIf sj.Contains("1900-1-1 ") Then
sj = sj.Replace("1900-1-1 ","")
ElseIf sj.Contains("1900/01/01 ") Then
sj = sj.Replace("1900/01/01 ","")
ElseIf sj.Contains("1900/1/1 ") Then
sj = sj.Replace("1900/1/1 ","")
End If
mk = DataTables("采集数据").Select(Filter & "and T < '1900-01-01 08:01:00'").Count > 0
nk = DataTables("采集数据").Select(Filter & "and T > '1900-01-01 11:59:59' and T < '1900-01-01 13:01:00'").Count > 0
ek = DataTables("采集数据").Select(Filter & "and T > '1900-01-01 16:59:59'").Count > 0
mc = DataTables("采集数据").Select(Filter & "and T < '1900-01-01 08:31:00' and T > '1900-01-01 08:00:59'").Count > 0
ez = DataTables("采集数据").Select(Filter & "and T > '1900-01-01 16:29:59' and T < '1900-01-01 17:00:00'").Count > 0
nc = DataTables("采集数据").Select(Filter & "and T > '1900-01-01 13:00:59' and T < '1900-01-01 13:31:00'").Count > 0
mz = DataTables("采集数据").Select(Filter & "and T > '1900-01-01 11:29:59' and T < '1900-01-01 12:00:00'").Count > 0
If Functions.Execute("Get","设置",16).Contains(Format(dy.AddDays(i),"MMdd")) = False AndAlso (dy.AddDays(i).DayOfWeek > 0 Or Functions.Execute("Get","设置",15).Contains(Format(dy.AddDays(i), "MMdd"))) Then
If dks.Count > 0 Then
If dk Is Nothing Then
dk = DataTables("考勤").addnew()
End If
dk("编号") = r("编号")
dk("姓名") = r("姓名")
dk("Y") = dy.AddDays(i).Year
dk("M") = dy.AddDays(i).Month
dk("D") = dy.AddDays(i).Day
dk("时间") = sj
If Functions.Execute("Get","设置",19).Contains(r("姓名")) Then
dk("考勤") = 480
ElseIf (mk And nk And ek) Or ((mk Or mc) And (ek Or ez)) Then
dk("考勤") = 480
ElseIf ((mk Or mc) And nk And ek = False And ez = False) Or (nk And (ek Or ez) And mk = False And mc = False) Then
dk("考勤") = 240
Else
dk("考勤") = 0
End If
If mc And nc Then
dk("迟到次") = 2
ElseIf mc Or nc Then
dk("迟到次") = 1
Else
dk("迟到次") = 0
End If
If ez And mz Then
dk("早退次") = 2
ElseIf ez Or mz Then
dk("早退次") = 1
Else
dk("早退次") = 0
End If
dk.save
Else
If dk Is Nothing Then
dk = DataTables("考勤").addnew()
End If
dk("编号") = r("编号")
dk("姓名") = r("姓名")
dk("Y") = dy.AddDays(i).Year
dk("M") = dy.AddDays(i).Month
dk("D") = dy.AddDays(i).Day
dk("时间") = "没有记录"
dk("考勤") = 0
dk("迟到次") = 0
dk("早退次") = 0
dk.save
End If
Else
If dks.Count > 0 Then
If Functions.Execute("Get","设置",19).Contains(r("姓名")) Or (mk And nk And ek) Or ((mk Or mc) And (ek Or ez)) Then
If dk Is Nothing Then
dk = DataTables("考勤").addnew()
End If
dk("编号") = r("编号")
dk("姓名") = r("姓名")
dk("Y") = dy.AddDays(i).Year
dk("M") = dy.AddDays(i).Month
dk("D") = dy.AddDays(i).Day
dk("时间") = sj
dk("考勤") = 480
If mc And nc Then
dk("迟到次") = 2
ElseIf mc Or nc Then
dk("迟到次") = 1
Else
dk("迟到次") = 0
End If
If ez And mz Then
dk("早退次") = 2
ElseIf ez Or mz Then
dk("早退次") = 1
Else
dk("早退次") = 0
End If
dk.save
End If
End If
End If
Next
Next
DataTables("采集数据").ResumeRedraw
'结束--考勤计算
Total = 1
Return 1
Else
Total = 1
Return 0
End If
加好友 
发短信
Post By：2019/1/12 14:27:00 [显示全部帖子]
