主题：[讨论]

项目中，需要把合同按照期限，拆分计算每个月的金额。附件例子中的代码，20个合同拆分成300多条记录，大概要20多秒；2万多个合同需要好几个小时。请教如何能优化下执行效率？ 

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

点击浏览该文件:test.rar

Dim i, j, k As Integer
i = 0

Dim dt1, dt2, dt3 As Date

Dim y, m, d As Integer

Dim BillingAmount As Double
Dim Duration As Integer

Dim FirstM As String
Dim LastM As String
Dim CurrentM As String
Tables("收益计划表").StopRedraw
For Each r As Row In Tables("合同").Rows                  '在主表选定范围内循环取值
   
    k = 0
    '获取Billing Plan数据, 金额,日期及唯一编号
    BillingAmount = r("金额")
   
    dt1 = r("开始日期")
    dt2 = r("结束日期")
    dt3 = r("签约日期")
   
    Duration = Datediff("d",dt1,dt2) + 1
    FirstM = format(dt1.Year,"0000") & format(dt1.Month,"00")
    LastM = format(dt2.Year,"0000") & format(dt2.Month,"00")
   
    '向计算表添加数据
    For j = 0 To datediff("m",dt1,dt2)
        CurrentM = format(dt1.Year,"0000") & format(dt1.Month,"00")
        y = dt1.year
        m = dt1.month
       
        Dim nrev As Row = Tables("收益计划表").AddNew()
        nrev("合同号") = r("合同号")
        nrev("金额") = r("金额")
        nrev("计划时间") = format(dt1.Year,"0000") & format(dt1.Month,"00")
       
       
       
        '计算每个月的天数
        If CurrentM = FirstM And CurrentM = LastM Then
            nrev("天数") = Datediff("d",dt1,dt2)
            nrev("计划金额") = BillingAmount
        ElseIf CurrentM = FirstM Then '为第一个月
            nrev("天数") = dt1.DaysInMonth(y,m) - dt1.Day + 1
            nrev("计划金额") = round2( nrev("天数") / Duration * BillingAmount , 2)
        ElseIf CurrentM = lastM Then '为最后一个月
            nrev("天数") = dt2.day
            nrev("计划金额") = round2( nrev("天数") / Duration * BillingAmount , 2)
        Else    '为其他月份
            nrev("天数") = dt1.DaysInMonth(y,m)
            nrev("计划金额") = round2( nrev("天数") / Duration * BillingAmount , 2)
        End If
       
        dt1 = dt1.AddMonths(1)
    Next
    k = k + 1
Next
Tables("收益计划表").ResumeRedraw

多谢甜版，确实快很多了