为了根据货品出库计划中每种货品的需求数量在库存中找到每钟货品的最佳的取货位置，生成取货明细以便照单取货，我编写了如下代码。
蓝字部分是插入测试效率的代码；
红字和绿字部分分别是利用集合和利用字典来保存用于生成取货单新增行的代码，算是两种方案吧；
运行得结果是：不管采用哪种方案，在两三百行数据的情况下，前三段代码都在几乎不足0.1秒的时间内运行完毕，效率应该是可以接受的。但是第四段代码足足用了160秒之多，效率实在太低。把帮助文件相关的章节又看了一遍，仍然搞不懂问题所在。请高手赐教！
If Tables("货品出库计划").Rows.Count = 0 Then
MessageBox.Show("本次出库信息为空,系统禁止提交!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Return
End If
pause = True
Dim ttt As Date = Date.now
Dim sppp As TimeSpan
'计算本单号各产品的出库总数量
Tables("货品出库计划").filter = "单号 ='" & e.Form.Controls("单号").Text & "' and 单号 Is Not Null"
Dim dic As new Dictionary(Of String,Double)
Dim r As Row
Dim dr As DataRow
Dim v,v1,v2 As Double
Dim key As String
dic.Clear()
For Each r In Tables("货品出库计划").Rows
If dic.ContainsKey(r("产品条码")) Then
Continue For
Else
v = Tables("货品出库计划").Compute("Sum(数量)","产品条码 ='" & r("产品条码") & "'")
dic.Add(r("产品条码"),v)
End If
Next
sppp = Date.now - ttt
MessageBox.Show("第一段:" & sppp.TotalSeconds & "秒")
ttt = Date.Now
dr = DataTables("出库计划记录").Find("单号 ='" & e.Form.Controls("单号").text & "'")
If dr Is Nothing Then
Dim st() As String = {"收货库房","发货单位","发货人","收货人","收货单位","发货库房","出库类型","计划日期"}
r = Tables("出库计划记录").AddNew()
For Each key In st
r(key) = e.Form.Controls(key).Value
Next
r("单号") = e.Form.Controls("单号").text
r.Save()
End If
sppp = Date.now - ttt
MessageBox.Show("第二段:" & sppp.TotalSeconds & "秒")
ttt = Date.Now
'根据本单各产品的本地取货数量计算取货位置(明细)
DataTables("取货明细").DataRows.Clear()
Dim sts As String() = {"货号","颜色","尺码号","产品条码","产品名称","吊牌价格","库房","库区","库位"}
If dic.Keys.count > 0 Then
'Dim dic1 As new Dictionary(Of DataRow,Double)
Dim lst0,lst1,lst2,lst3,lst4,lst5,lst6,lst7,lst8 As new List(Of String)
Dim lst As new List(Of Double)
Dim cmd As New SQLCommand
cmd.C
cmd.CommandText = "Select * From {库存表} Where 库房 ='" & User.Group & "库房'" 'And 产品条码 = '" & key & "'"
Dim dt As DataTable
Dim drs As new List(Of DataRow)
dt = cmd.ExecuteReader()
For Each key In dic.Keys
Dim id As String = ""
v1 = dic(key) '赋值给初始取货数量
Do While v1 > 0
If id = "" Then
drs = dt.Select("产品条码 = '" & key & "'" )
Else
drs = dt.Select(id & " And 产品条码 = '" & key & "'" )
End If
If drs.Count > 0 Then
v2 = Math.Abs(v1 - drs(0)("库存数量"))
For i As Integer = 0 To drs.count - 1
v2 = Math.Min(v2,Math.Abs(v1 - drs(i)("库存数量")))
Next
dr = dt.Find("库存数量 =" & v1 + v2 & " And 产品条码 = '" & key & "'" )
If dr IsNot Nothing Then
lst0.Add(dr(sts(0)))
lst1.Add(dr(sts(1)))
lst2.Add(dr(sts(2)))
lst3.Add(dr(sts(3)))
lst4.Add(dr(sts(4)))
lst5.Add(dr(sts(5)))
lst6.Add(dr(sts(6)))
lst7.Add(dr(sts(7)))
lst8.Add(dr(sts(8)))
lst.add(v1)
'dic1.Add(dr,v1)
v1 = 0
Else
dr = dt.Find("库存数量 =" & v1 - v2 & " And 产品条码 = '" & key & "'" )
If dr IsNot Nothing Then
lst0.Add(dr(sts(0)))
lst1.Add(dr(sts(1)))
lst2.Add(dr(sts(2)))
lst3.Add(dr(sts(3)))
lst4.Add(dr(sts(4)))
lst5.Add(dr(sts(5)))
lst6.Add(dr(sts(6)))
lst7.Add(dr(sts(7)))
lst8.Add(dr(sts(8)))
lst.add(v1)
'dic1.Add(dr,v1)
v1 = v1 - dr("库存数量")
If id = "" Then
id = "[_Identify] <>" & dr("_Identify")
Else
id = id & "And"
id = id & "[_Identify] <>" & dr("_Identify")
End If
End If
End If
End If
Loop
Next
sppp = Date.now - ttt
MessageBox.Show("第三段:" & sppp.TotalSeconds & "秒")
ttt = Date.Now
If lst.count > 0 Then
DataTables("取货明细").StopRedraw()
For i As Integer = 0 To lst.count - 1
dr = DataTables("取货明细").AddNew()
dr(sts(0)) = lst0(i)
dr(sts(1)) = lst1(i)
dr(sts(2)) = lst2(i)
dr(sts(3)) = lst3(i)
dr(sts(4)) = lst4(i)
dr(sts(5)) = lst5(i)
dr(sts(6)) = lst6(i)
dr(sts(7)) = lst7(i)
dr(sts(8)) = lst8(i)
dr("计划取货数量") = lst(i)
dr("单号") = e.Form.Controls("单号").text
Next
DataTables("取货明细").ResumeRedraw()
End If
'If dic1.Keys.count > 0 Then
'DataTables("取货明细").StopRedraw()
'For Each dr In dic1.keys
'Dim dr1 As DataRow = DataTables("取货明细").AddNew() '此处可能有问题
'For i As Integer = 0 To sts.length - 1
'dr1(sts(i)) = dr(sts(i))
'Next
'dr1("单号") = e.Form.Controls("单号").text
'dr1("计划取货数量") = dic1(dr)
'Next
'DataTables("取货明细").ResumeRedraw()
'End If
End If
sppp = Date.now - ttt
MessageBox.Show("第四段:" & sppp.TotalSeconds & "秒")
ttt = Date.Now
DataTables("取货明细").Save()
Forms("出库明细及取货明细").Open()
加好友 
发短信
Post By：2013/10/24 21:09:00 [只看该作者]
