主题：[求助]请老师帮我写个根据要求抽取数据的代码

甜版，有空帮我写下吗，这个双休我的时间全泡在这段代码上了。

 汗

 

Dim drs As List(Of DataRow) = DataTables("轧机1号").Select("", "日期,卷号")
drs(0)("投料量")=drs(0)("重量")
Dim tll As Double = drs(0)("重量")
For i As Integer = 1 To drs.Count - 1
    If drs(i)("卷号") = drs(i-1)("卷号")
        drs(i)("投料量") = tll
    Else
        Dim fdr As DataRow = DataTables("轧机1号").Find("卷号 = '" & drs(i)("卷号").Substring(0,drs(i)("卷号").length - 1)  & "'")
        If fdr IsNot Nothing Then
            Dim drs_temp As List(of DataRow) = DataTables("轧机1号").Select("substring(卷号,1," & drs(i)("卷号").Length - 1 & ") = '" & fdr("卷号") & "' and len(卷号) = " & drs(i)("卷号").Length, "日期")
            Dim zl As Double = drs_temp(0)("重量")
            For j As Integer = 1 To drs_temp.Count - 1
                If drs_temp(j)("卷号") <> drs_temp(j-1)("卷号") Then
                    zl += drs_temp(j)("重量")
                End If
            Next
            drs(i)("投料量") = drs(i)("重量") / zl * fdr("投料量")
            tll = drs(i)("投料量")
        Else
            tll = drs(i)("重量")
            drs(i)("投料量") = tll
        End If
    End If
Next

甜老师，代码执行遇到二个问题：

一是代码不知什么地方有个限定，我放入项目的实例中计算结果错误，实例文件已经上传

二是执行效率太差，项目文件中有18000行数据，执行了二分钟也没执行完，最后我不得不关闭进程

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:投料量分摊new1.rar

Dim drs As List(Of DataRow) = DataTables("轧机1号").Select("", "卷号")
drs(0)("投料量")=drs(0)("重量")
Dim tll As Double = drs(0)("重量")
Dim dic As New Dictionary(Of String, Double())
For i As Integer = 1 To drs.Count - 1
    If drs(i)("卷号") = drs(i-1)("卷号")
        drs(i)("投料量") = tll
    Else
        Dim str As String = drs(i)("卷号").Substring(0,drs(i)("卷号").length - 1)
        If dic.ContainsKey(str) = False Then
            Dim fdr As DataRow = DataTables("轧机1号").Find("卷号 = '" & str  & "'", "起始时间")
            If fdr IsNot Nothing Then
                Dim drs_temp As List(of DataRow) = DataTables("轧机1号").Select("substring(卷号,1," & drs(i)("卷号").Length - 1 & ") = '" & fdr("卷号") & "' and len(卷号) = " & drs(i)("卷号").Length, "卷号")
                Dim zl As Double = drs_temp(0)("重量")
                For j As Integer = 1 To drs_temp.Count - 1
                    If drs_temp(j)("卷号") <> drs_temp(j-1)("卷号") Then
                        zl += drs_temp(j)("重量")
                    End If
                Next
                dic.Add(str, new Double(){zl, fdr("投料量")})
            Else
                tll = drs(i)("重量")
                drs(i)("投料量") = tll
                Continue For
            End If
        End If
        drs(i)("投料量") = drs(i)("重量") / dic(str)(0) * dic(str)(1)
        tll = drs(i)("投料量")
    End If
Next

甜老师，代码放入项目文件执行后完全正确了，但效率问题还是没解决，整张表执行完用了5分钟，有什么办法改善吗？

 

没办法改善的，最多如下。如果要改，就多加两列 父重量、子重量

 

DataTables("轧机1号").StopRedraw
Dim drs As List(Of DataRow) = DataTables("轧机1号").Select("", "卷号")
drs(0)("投料量")=drs(0)("重量")
Dim tll As Double = drs(0)("重量")
Dim dic As New Dictionary(Of String, Double())
Dim Dic_dr As new Dictionary(of DataRow, Double)
For i As Integer = 1 To drs.Count - 1
    If drs(i)("卷号") = drs(i-1)("卷号")
        Dic_dr.Add(drs(i), tll)
    Else
        Dim str As String = drs(i)("卷号").Substring(0,drs(i)("卷号").length - 1)
        If dic.ContainsKey(str) = False Then
            Dim fdr As DataRow = DataTables("轧机1号").Find("卷号 = '" & str  & "'", "起始时间")
            If fdr IsNot Nothing Then
                Dim drs_temp As List(of DataRow) = DataTables("轧机1号").Select("substring(卷号,1," & drs(i)("卷号").Length - 1 & ") = '" & fdr("卷号") & "' and len(卷号) = " & drs(i)("卷号").Length, "卷号")
                Dim zl As Double = drs_temp(0)("重量")
                For j As Integer = 1 To drs_temp.Count - 1
                    If drs_temp(j)("卷号") <> drs_temp(j-1)("卷号") Then
                        zl += drs_temp(j)("重量")
                    End If
                Next
                dic.Add(str, new Double(){zl, fdr("投料量")})
            Else
                tll = drs(i)("重量")
                Dic_dr.Add(drs(i), tll)
                Continue For
            End If
        End If
        tll = drs(i)("重量") / dic(str)(0) * dic(str)(1)
        Dic_dr.Add(drs(i), tll)
    End If
Next
For Each dr As DataRow In dic_dr.Keys
    dr("投料量") = dic_dr(dr)
Next
DataTables("轧机1号").ResumeRedraw

多加二列没有问题的，但具体如何做，能把我的例子改下传上来吗？

DataTables("轧机1号").StopRedraw
Dim drs As List(Of DataRow) = DataTables("轧机1号").Select("", "卷号")
drs(0)("投料量")=drs(0)("重量")
Dim tll As Double = drs(0)("重量")
Dim dic As New Dictionary(Of String, Double())
Dim Dic_dr As new Dictionary(of DataRow, Double)
For i As Integer = 1 To drs.Count - 1
    If drs(i)("卷号") = drs(i-1)("卷号")
        Dic_dr.Add(drs(i), tll)
    Else
        Dim str As String = drs(i)("卷号").Substring(0,drs(i)("卷号").length - 1)
        If dic.ContainsKey(str) = False Then
            Dim fdr As DataRow = DataTables("轧机1号").Find("卷号 = '" & str  & "'", "起始时间")
            If fdr IsNot Nothing Then
                Dim drs_temp As List(of DataRow) = DataTables("轧机1号").Select("substring(卷号,1," & drs(i)("卷号").Length - 1 & ") = '" & fdr("卷号") & "' and len(卷号) = " & drs(i)("卷号").Length, "卷号")
                Dim zl As Double = drs_temp(0)("重量")
                For j As Integer = 1 To drs_temp.Count - 1
                    If drs_temp(j)("卷号") <> drs_temp(j-1)("卷号") Then
                        zl += drs_temp(j)("重量")
                    End If
                Next
                dic.Add(str, new Double(){zl, tll})
            Else
                tll = drs(i)("重量")
                Dic_dr.Add(drs(i), tll)
                Continue For
            End If
        End If
        tll = drs(i)("重量") / dic(str)(0) * dic(str)(1)
        Dic_dr.Add(drs(i), tll)
    End If
Next
For Each dr As DataRow In dic_dr.Keys
    dr("投料量") = dic_dr(dr)
Next
DataTables("轧机1号").ResumeRedraw

甜版，实在太感谢了，现在执行完全表只要30秒了，这个速度理想了。