以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  运算速度问题  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=186459)

--  作者:朱女士
--  发布时间:2023/5/5 9:41:00
--  运算速度问题
老师您好!
  昨天我提的代码计算速度问题,还没有解决,我今天又把两个模块合并计算后,共用了58分钟才能计算完毕,这种速度我以前从未遇到过,我也不知从哪里入手解决,烦请老师帮忙,谢谢!
 完整代码如下:

Dim Result As DialogResult
Result = MessageBox.Show("您是从头计算所有数据(y),还是接着上次计算(n)?","提示", MessageBoxButtons.YesNo, MessageBoxIcon.Question)

If Result = DialogResult.Yes Then
    DataTables("车间扫码表").LoadFilter = ""
    DataTables("车间扫码表").Load
    For Each dr As DataRow In DataTables("车间扫码表").DataRows
        If dr("jsf") IsNot Nothing Then
            dr("jsf") = Nothing
        End If
    Next
    
    \'如果从头计算还要清空表
    DataTables("实时工序计算表").deletefor("")
    DataTables("实时工序明细表").deletefor("")
End If


\'\'1、加载表
DataTables("车间扫码表").LoadFilter = ""
DataTables("车间扫码表").Load
Tables("ddqdb").Sort = "清单条码编码"

Dim fr As DataRow
fr = DataTables("车间扫码表").DataRows(0)
DataTables("ddqdb").LoadFilter = "[清单条码编码]>=\'" & fr("清单条码编码") & "\'"
DataTables("ddqdb").Load

DataTables("车间扫码表").LoadFilter = "[jsf] is null"
DataTables("车间扫码表").Load


\'2、将车间扫描表逐行镜像写入实时工序计算表

Dim Cols1() As String = {"日期", "清单条码编码", "ygdm", "员工姓名", "gxdm", "工序名称", "开工时间", "结束时间", "工序耗时", "jsbm1", "bs" }
Dim Cols2() As String = {"日期", "清单条码编码", "ygdm", "员工姓名", "gxdm", "工序名称", "开工时间", "结束时间", "工序耗时", "jsbm1", "bs" }

For Each dr1 As DataRow In DataTables("车间扫码表").DataRows
    dr1("jsf") = "√"
    
    Dim dr2 As DataRow = DataTables("实时工序计算表").AddNew()
    For i As Integer = 0 To Cols1.Length - 1
        dr2(Cols2(i)) = dr1(Cols1(i)) 
    Next
Next


\'\'3、工序填入顺序号
For Each er As DataRow In DataTables("实时工序计算表").DataRows
    Dim gm As String = er("gxdm")
    Dim tm As String = er("清单条码编码")
    
    Dim br As DataRow = DataTables("gxdmb").find("gxdm=\'" & gm & "\'")
    If br IsNot Nothing Then
        er("顺序号") = br("顺序号")
    End If
    Dim ur As DataRow = DataTables("ddqdb").find("清单条码编码=\'" & tm & "\'")
    If ur IsNot Nothing Then
        If ur("结算单位") = "重量" Then
            er("重量") = ur("重量") \'填入重量
        Else If ur("结算单位") = "数量" Then
            er("件数") = ur("件每台") * ur("台数")
        End If
    End If 
Next



\'\'以下是按bs与开工时间进行第一次分劈,
\'\'
Dim drs As List(Of DataRow)
Dim Nas As New List(Of String) \'bs长度18
Dim Nbs As New List(Of String) \'bs长度6
Dim Ncs As New List(Of String) \'bs长度12
Dim l As Integer

Dim Arys As List(Of String()) 
Arys = DataTables("实时工序计算表").GetValues("bs|开工时间") 
For Each Ary As String() In Arys
    Dim t1 As Date = "#" & ary(1) & "#"
    Dim t2 As Date = "#" & t1.AddMinutes(1) & "#"
    
    Dim zzl As Double = DataTables("实时工序计算表").Compute("sum(重量)", "bs=\'" & Ary(0) & "\'and 开工时间>= #" & t1 & "# and 开工时间< #" & t2 & "# ")
    drs = DataTables("实时工序计算表").Select("[bs]=\'" & Ary(0) & "\'and 开工时间>= #" & t1 & "# and 开工时间< #" & t2 & "# ", "工序耗时")
    
    For Each dr As DataRow In drs
        If dr IsNot Nothing Then
            
            Dim gxhs As Double = dr("工序耗时")
            Dim dzl As Double = dr("重量")
            If dzl <> 0 Then
                If zzl <> 0 Then
                    
                    Dim sjhs As Double = Round2((dzl * gxhs / zzl), 2)
                    dr("实际耗时") = Round2((dzl * gxhs / zzl), 2) 
                End If
            Else
                dr("实际耗时") = Nothing
            End If
        End If
    Next 
    
Next

\'\'以下是按清单条码与工序进行第二次分劈
Dim brys As List(Of String()) 
brys = DataTables("实时工序计算表").GetValues("清单条码编码|工序名称")
Dim zl As Double
Dim js As Integer
For Each bry As String() In brys
    Dim pr As DataRow = DataTables("ddqdb").find("清单条码编码=\'" & bry(0) & "\'")
    
    If pr IsNot Nothing Then
        zl = pr("重量")
        js = pr("件每台") * pr("台数") 
        Dim gxhs As Double = DataTables("实时工序计算表").Compute("Sum(实际耗时)", "清单条码编码= \'" & bry(0) & "\' and 工序名称=\'" & bry(1) & "\'")
        
        \'查询符合条件的多条记录
        For Each ets As DataRow In DataTables("实时工序计算表").Select("清单条码编码= \'" & bry(0) & "\' and 工序名称=\'" & bry(1) & "\'")
            If ets IsNot Nothing Then 
                ets("已分劈") = "f"
                Dim dhs As Double = ets("实际耗时")
                If zl<> 0 Or js <> 0 Then
                    ets("重量") = Round2(dhs / gxhs * zl, 2)
                    ets("件数") = Round2(dhs / gxhs * js, 2)
                End if
            End If
        Next
    End if 
Next


MessageBox.Show("计算完毕!", "提示!")
Forms("实时工序优速计算").close
MainTable = Tables("实时工序计算表")

--  作者:y2287958
--  发布时间:2023/5/5 9:44:00
--  
这种问题必须上例子
--  作者:朱女士
--  发布时间:2023/5/5 9:58:00
--  
我昨天把数据表都上传给您了,用我现在再传一遍吗
--  作者:有点蓝
--  发布时间:2023/5/5 10:02:00
--  
请提供实例:项目文件+含有测试数据的数据库文件
--  作者:朱女士
--  发布时间:2023/5/5 10:05:00
--  
这个问题已经困扰我4天了,实在给您添麻烦了!
--  作者:朱女士
--  发布时间:2023/5/5 14:02:00
--  
老师您好!
 我已给您传过去了,请测试一下,我的计算速度慢,问题出在哪里,谢谢!

--  作者:朱女士
--  发布时间:2023/5/5 14:03:00
--  
文件太大了,传不过去
--  作者:有点蓝
--  发布时间:2023/5/5 14:06:00
--  
新建一个测试项目,不要发原项目,数据库保留一万几千条测试数据即可
--  作者:朱女士
--  发布时间:2023/5/5 14:07:00
--  
好的,谢谢
--  作者:朱女士
--  发布时间:2023/5/5 14:48:00
--  
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目1_202305051443.zip