Dim rst As Object
Dim cnn As Object
Dim strSQL As String
Dim Month_EndDate As Date
Dim Month_FirstDate As Date
Dim SumQty As Double
Dim SumAmount As Currency
'先计算本日金额
CurrentDb.Execute "update [test] set 本日金额 = 本日单价 * 本日数量"
strSQL = "select * from [test] order by 日期"
Set cnn = CurrentProject.Connection
Set rst = CreateObject("adodb.recordset")
rst.Open strSQL, cnn, 1, 3
Do While Not rst.EOF
Month_EndDate = rst!日期
Month_FirstDate = DateSerial(Year(Month_EndDate), Month(Month_EndDate), 1) '取月初日期
'取同一个月份，同一个项目到截止日期累计数量
SumQty = DSum("本日数量", "test", "日期 >= #" & Month_FirstDate & "# and 日期 <= #" & Month_EndDate & "# and 项目长代码 = '" & rst!项目长代码 & "'")
'取同一个月份，同一个项目到截止日期累计金额
SumAmount = DSum("本日金额", "test", "日期 >= #" & Month_FirstDate & "# and 日期 <= #" & Month_EndDate & "# and 项目长代码 = '" & rst!项目长代码 & "'")
rst!累计数量 = SumQty
rst!累计金额 = SumAmount
rst.Update
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
MsgBox "计算完成！", vbInformation, "提示"
通过对表中记录循环进行处理。
