以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  [求助]代码优化  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=130080)
--  作者：yds
--  发布时间：2019/1/12 14:27:00
--  [求助]代码优化
下面是根据从考勤机上面下载的数据计算考勤的代码，感觉运行速度很慢，各位老大看看能怎么优化一下，谢谢！

人员表
编号姓名密码权限启用部门
1张三0TRUE后勤部
2李四0FALSE后勤部
采集数据表
姓名编号时间机器方式IPYMDT方法
张三12019-01-02 08:04:4511192.168.1.24520191208:04:45采集
张三12019-01-02 17:08:5611192.168.1.24520191217:08:56采集
李四22019-01-03 17:08:5111192.168.1.24520191317:08:51采集

考勤表
编号姓名YMD时间考勤迟到次早退次请假出差加班
1张三20191208:04:45|17:08:5648000000
2李四20191317:08:51000000

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
--  作者：有点蓝
--  发布时间：2019/1/12 15:08:00
--  
没看懂您的逻辑，使用文字说明一下操作逻辑，上传具体实例测试
--  作者：YDS
--  发布时间：2019/1/12 15:47:00
--  
上午上班 ：8：00 上午下班：12：00下午上班：13：00下午下班17：00

上班时间晚30分钟以内算迟到记1次，下班提前30分钟以内算早退记1次
上午8：30之前有考勤并且下午16.30以后有考勤算全勤  记480分钟
有8：30之前考勤并且有11：30-13：30之间考勤  没有16：30以后考勤算半天 记240分钟
有16：30之后考勤并且有11：30-13：30之间考勤  没有8：30以前考勤算半天 记240分钟
--  作者：有点蓝
--  发布时间：2019/1/12 16:59:00
--  
试试

Dim ss As String = "08:00:00"
Dim ssz As String = "08:30:00"

Dim sx As String = "12:00:00"
Dim sxz As String = "11:30:00"

Dim xs As String = "13:00:00"
Dim xsz As String = "13:30:00"

Dim xx As String = "17:00:00"
Dim xxz As String = "16:30:00"

Dim dr As DataRow

For Each bh() As String In DataTables("人员").GetValues("编号|姓名","启用 = 1")
    For Each dd() As String In  DataTables("采集数据").GetValues("Y|M|D","编号 = \'" & bh(0) & "\'")
        dr = DataTables("勤表").AddNew
        dr("编号") = bh(0)
        dr("姓名") = bh(1)
        dr("Y") = dd(0)
        dr("M") = dd(1)
        dr("D") = dd(2)
        Dim ts() As String = DataTables("采集数据").GetValues("T", "编号 = \'" & bh(0) & "\' and Y = \'" & dd(0) & "\' And M = \'" & dd(1) & "\' And D = \'" & dd(2) & "\'")
        Dim ti As String = ""
        Dim cd As Intege = 0
        Dim zt As Intege = 0
        Dim am As Intege = 0
        Dim pm As Intege = 0
        Dim all As Intege = 0
        For Each t As String In ts
            Dim st As String = t.SubString(t.Length - 8)
            ti = ti & "|" & st
            If st > ssz AndAlso st < ssz OrElse st > xs AndAlso st < xsz Then
                cd += 1
            ElseIf st > sxz AndAlso st < sx OrElse st > xxz AndAlso st < xx Then
                zt+= 1
            End If
            If st < ss OrElse st > xxz Then
                all+=1
            End If
            If st < ss OrElse st > sxz AndAlso st < xsz Then
                am += 1
            End If
            If st > xxz OrElse st > sxz AndAlso st < xsz Then
                pm += 1
            End If
        Next
        If all >= 2 Then
            dr("考勤") = 480
        Else
            If am >= 2 OrElse pm >= 2
                dr("考勤") = 240
            End If
        End If
        dk("迟到次") = cd
        dk("早退次") = zt
        dk("时间") = ti.Trim("|")
    Next
Next