- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- [讨论] (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=135630)
-- 发布时间：2019/5/30 14:52:00
-- [讨论]
项目中，需要把合同按照期限，拆分计算每个月的金额。附件例子中的代码，20个合同拆分成300多条记录，大概要20多秒；2万多个合同需要好几个小时。请教如何能优化下执行效率？
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:test.rar |
-- 发布时间：2019/5/30 14:59:00
--
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
-- 发布时间：2019/5/30 17:31:00
--
多谢甜版，确实快很多了