昨天我提的代码计算速度问题，还没有解决，我今天又把两个模块合并计算后，共用了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("实时工序计算表")
加好友 
发短信
Post By：2023/5/5 9:41:00 [只看该作者]
