主题：汇总求助

谢谢C版恢复.

除了大数据量的速度较慢外,该月结表是最简单方便的,真正一键生成,而且随时都可生成任何月份的月结表.如果单独再设计一张月初表,从操作者的角度,月初表的数据如何处理?还能做到一键生成吗

复制和填充数据比较耗时，过多的统计也很耗时。在C版的基础上做了些代码的改动，如下，测试有效。

Dim st As Date = Date.Now   '用于计算时间

Dim s As String = e.Form.Controls("月份").Value
If s <> "" Then
    Tables("月报表").StopRedraw()   '停止重绘
    DataTables("月报表").DataRows.Clear
    Dim dt_in As List(Of DataRow)
    dt_in = DataTables("入仓").Select("型号 is not null", "型号,规格,月份")   '排序取出 入仓 全部数据
  
    Dim r As Row
    Dim sum_curr_money, sum_prev_money As Double
    Dim sum_curr_count, sum_prev_count As Integer
  
    r = Tables("月报表").AddNew 
    r("型号") = dt_in(0)("型号")
    r("规格") = dt_in(0)("规格")
    If dt_in(0)("月份") < s Then   '之前月
        sum_prev_count = sum_prev_count + dt_in(0)("入仓数量")
        sum_prev_money = sum_prev_money + dt_in(0)("入仓金额")
    Else If dt_in(0)("月份") = s Then   '本月份
        sum_curr_money = sum_curr_money + dt_in(0)("入仓金额")
        sum_curr_count = sum_curr_count + dt_in(0)("入仓数量")
    End If

    For i As Integer = 1 To dt_in.Count - 1   '写入型号和规格,同时统计入仓数量和金额
        If dt_in(i)("型号") <> dt_in(i-1)("型号") OrElse dt_in(i)("规格") <> dt_in(i-1)("规格")  Then   '不同产品
            r("本月入仓_数量") = sum_curr_count
            r("本月入仓_金额") = sum_curr_money
            r("上月结存_数量") = sum_prev_count   '暂存
            r("上月结存_金额") = sum_prev_money   '暂存
          
            r = Tables("月报表").AddNew   '插入新数据
            r("型号") = dt_in(i)("型号")
            r("规格") = dt_in(i)("规格")
            sum_curr_money = 0
            sum_curr_count = 0
            sum_prev_count = 0
            sum_prev_money = 0
        End If

        If dt_in(i)("月份") < s Then   '之前月
            sum_prev_count = sum_prev_count + dt_in(i)("入仓数量")
            sum_prev_money = sum_prev_money + dt_in(i)("入仓金额")
        Else If dt_in(i)("月份") = s Then   '本月份
            sum_curr_money = sum_curr_money + dt_in(i)("入仓金额")
            sum_curr_count = sum_curr_count + dt_in(i)("入仓数量")
        End If
    Next

    r("本月入仓_数量") = sum_curr_count
    r("本月入仓_金额") = sum_curr_money
    r("上月结存_数量") = sum_prev_count   '暂存
    r("上月结存_金额") = sum_prev_money   '暂存

MessageBox.Show("复制型号和规格耗时: " & (Date.Now - st).TotalSeconds & "秒")
st = Date.Now   '用于计算时间

    For Each dr As DataRow In DataTables("月报表").DataRows   '填充统计数据
        sum_curr_count = 0   '累计本月出仓数量
        sum_prev_count = 0   '累计之前出仓数量
        Dim drs_out As List(Of DataRow)
        Dim filter As String =  "型号 = '" & dr("型号") & "' And 规格 = '" & dr("规格") & "'"
        drs_out = DataTables("出仓").Select(filter, "月份")   '排序取出 出仓 全部数据
        For Each dr_out As DataRow In drs_out
            If dr_out("月份") < s Then
                sum_prev_count = sum_prev_count + dr_out("出仓数量")
            Else If dr_out("月份") = s Then
                sum_curr_count = sum_curr_count + dr_out("出仓数量")
            Else
                Exit For
           End If
        Next
      
        Dim sum_in_prev_count As Integer = dr("上月结存_数量")   '从表中取出暂存数据
        Dim sum_in_prev_money As Double = dr("上月结存_金额")   '从表中取出暂存数据
        dr("本月出仓_数量") = sum_curr_count
        dr("上月结存_数量") = sum_in_prev_count - sum_prev_count
        dr("上月结存_金额") = sum_in_prev_money / sum_in_prev_count * dr("上月结存_数量")
    
        dr("本月加权平均单价") = (dr("上月结存_金额") + dr("本月入仓_金额"))/(dr("上月结存_数量") + dr("本月入仓_数量"))
        dr("本月结存_数量") = dr("上月结存_数量") + dr("本月入仓_数量") - dr("本月出仓_数量")
      
        dr("本月结存_金额") = dr("本月加权平均单价") * dr("本月结存_数量")
        dr("本月出仓_金额") = dr("本月加权平均单价") * dr("本月出仓_数量")
    Next
    Tables("月报表").ResumeRedraw()
End If

MessageBox.Show("统计和写入耗时: " & (Date.Now - st).TotalSeconds & "秒")

上面的代码，估计可以把时间控制在三四秒，再快的话......求高手吧。

有很大改善,谢了.好在每月只做一次.有时间我再测试一万条记录

这样更快：

 

 

DataTables("月报表").DataRows.Clear
Dim s As String = e.Form.Controls("月份").Value
Tables("月报表").StopRedraw
If s <> "" Then
    Dim n As Integer = e.Form.Controls("月份").Value
    DataTables("月报表").DataRows.Clear
    Dim Arys As List(Of String())
    Arys = DataTables("入仓").GetUniqueValues("", "型号","规格")
    For Each Ary As String() In Arys
        Dim r As Row = Tables("月报表").AddNew
        r("型号") = Ary(0)
        r("规格") = Ary(1)
    Next
   
    Dim drs As new Dictionary(of DataRow,String())
    For Each dr As DataRow In DataTables("月报表").DataRows
        Dim vals(8) As String
        Dim s1 As String = "型号 = '" & dr("型号") & "' And 规格 = '" & dr("规格") & "' And 月份 = '" & s & "'"
        Dim s2 As String = "型号 = '" & dr("型号") & "' And 规格 = '" & dr("规格") & "' And 月份 < " & n
        Dim Sum,Sum1 As Double
        vals(0) = DataTables("入仓").Compute("Sum(入仓数量)",s1)
        vals(1) = DataTables("入仓").Compute("Sum(入仓金额)",s1)
        vals(2) = DataTables("出仓").Compute("Sum(出仓数量)",s1)
       
        Sum = DataTables("入仓").Compute("Sum(入仓金额)",s2)
        Sum1 = DataTables("入仓").Compute("Sum(入仓数量)",s2)
        vals(3) = Sum1 - DataTables("出仓").Compute("Sum(出仓数量)",s2)
       
        '-----------------------计算上月结存金额
        vals(4) = Sum / Sum1 * dr("上月结存_数量")
        '-----------------------
       
        vals(5) = (dr("上月结存_金额") + dr("本月入仓_金额"))/(dr("上月结存_数量") + dr("本月入仓_数量"))
        vals(6) = dr("上月结存_数量") + dr("本月入仓_数量") - dr("本月出仓_数量")
       
        vals(7) = dr("本月加权平均单价") * dr("本月结存_数量")
        vals(8) = dr("本月加权平均单价") * dr("本月出仓_数量")
        drs.add(dr,vals)
    Next
    For Each dr As DataRow In drs.Keys
        Dim vals As String() = drs(dr)
        dr("本月入仓_数量") =vals(0)
        dr("本月入仓_金额") = vals(1)
        dr("本月出仓_数量") = vals(2)
        dr("上月结存_数量") = vals(3)
        dr("上月结存_金额") = vals(4)
        dr("本月加权平均单价") = vals(5)
        dr("本月结存_数量") = vals(6)
        dr("本月结存_金额") = vals(7)
        dr("本月出仓_金额") = vals(8)
    Next
End If
Tables("月报表").ResumeRedraw

测试12秒,还有计算错误,42楼代码2秒

哈哈，献丑了