代碼:
----------------------------------------------------------------
Option Compare Database
Option Explicit
Public gcurLastBalance As Currency '上次計算的余額
Public glngLastID As Long '上次的 ID
'查詢余額
'Version 1.0
'2003-05-06-15-15
'By Roadbeg
'要求以 Id 作為判斷依據(jù).(長整型)
Public Function GetBalance(ID As Long) As Currency
On Error GoTo Doerr
Dim curIn As Currency, curOut As Currency
Dim curRe As Currency
If glngLastID <> 0 Then
If ID > glngLastID Then
curIn = Nz(DSum("[IN]", "TEST", "ID <=" & str(ID) & " and ID>" & str(glngLastID)))
curOut = Nz(DSum("[OUT]", "TEST", "ID <=" & str(ID) & " and ID>" & str(glngLastID)))
curRe = gcurLastBalance + curIn - curOut
ElseIf ID < glngLastID Then
curIn = Nz(DSum("[IN]", "TEST", "ID >" & str(ID) & " and ID<=" & str(glngLastID)))
curOut = Nz(DSum("[OUT]", "TEST", "ID >" & str(ID) & " and ID<=" & str(glngLastID)))
curRe = gcurLastBalance - curIn + curOut
ElseIf ID = glngLastID Then
curRe = gcurLastBalance
End If
Else
curIn = DSum("[IN]", "TEST", "ID<=" & str(ID))
curOut = DSum("[OUT]", "TEST", "ID<=" & str(ID))
curRe = curIn - curOut
End If
' Debug.Print ID
glngLastID = ID
gcurLastBalance = curRe
GetBalance = curRe
Doerr:
End Function
'改變了 test 表的記錄值后,請調(diào)用此函數(shù)以強(qiáng)制 GetBalance 函數(shù)刷新.
Public Sub ResetBalance()
gcurLastBalance = 0
glngLastID = 0
End Sub
'這是 lwwvb 版主的函數(shù),我將它改為以 id 作為計算依據(jù)了,原理不變.
Public Function f(d As Long) As Currency
Dim a As Currency
Dim b As Currency
a = Nz(DSum("[in]", "test", "id <=" & str(d)))
b = Nz(DSum("[out]", "test", "id <=" & str(d)))
f = a - b
End Function
'請使用以下函數(shù)產(chǎn)生 600000 條隨機(jī)記錄,以檢驗函數(shù)在記錄較多時的效果.
Public Sub 產(chǎn)生隨機(jī)記錄()
Dim rst As DAO.Recordset
Dim i As Long
Debug.Print Now()
Set rst = CurrentDb.OpenRecordset("select [in] as dataa,[out] as datab from test")
For i = 0 To 600000
rst.AddNew
rst!dataa = CLng(Rnd() * 100)
rst!datab = CLng(Rnd() * 100)
rst.Update
Next i
rst.Close
Debug.Print Now()
End Sub
'一下是一組時間測試
Function t2()
Dim c1 As New class1
Dim rs As ADODB.Recordset
c1.Reset
Set rs = CurrentProject.Connection.Execute("SELECT [id], [in], [out], getbalance([id]) AS 余額 FROM test ORDER BY [id];")
Debug.Print c1.Elapsed
Set rs = Nothing
Set c1 = Nothing
End Function
Function t3()
Dim c1 As New class1
Dim rs As ADODB.Recordset
c1.Reset
Set rs = CurrentProject.Connection.Execute("SELECT [id], [in], [out], f([id]) AS 余額 FROM test ORDER BY [id]")
Debug.Print c1.Elapsed
Set rs = Nothing
Set c1 = Nothing
End Function
Function t1()
Dim c1 As New class1
Dim rs As ADODB.Recordset
c1.Reset
Set rs = CurrentProject.Connection.Execute("SELECT [id], [in], [out], (SELECT SUM(b.[in]-b.[out]) AS bb FROM test b WHERE a.[id] <= b.[id]) AS ye FROM test a ORDER BY [id]")
Debug.Print c1.Elapsed
Set rs = Nothing
Set c1 = Nothing
End Function
----------------------------------------------------------------
Option Compare Database
Option Explicit
Public gcurLastBalance As Currency '上次計算的余額
Public glngLastID As Long '上次的 ID
'查詢余額
'Version 1.0
'2003-05-06-15-15
'By Roadbeg
'要求以 Id 作為判斷依據(jù).(長整型)
Public Function GetBalance(ID As Long) As Currency
On Error GoTo Doerr
Dim curIn As Currency, curOut As Currency
Dim curRe As Currency
If glngLastID <> 0 Then
If ID > glngLastID Then
curIn = Nz(DSum("[IN]", "TEST", "ID <=" & str(ID) & " and ID>" & str(glngLastID)))
curOut = Nz(DSum("[OUT]", "TEST", "ID <=" & str(ID) & " and ID>" & str(glngLastID)))
curRe = gcurLastBalance + curIn - curOut
ElseIf ID < glngLastID Then
curIn = Nz(DSum("[IN]", "TEST", "ID >" & str(ID) & " and ID<=" & str(glngLastID)))
curOut = Nz(DSum("[OUT]", "TEST", "ID >" & str(ID) & " and ID<=" & str(glngLastID)))
curRe = gcurLastBalance - curIn + curOut
ElseIf ID = glngLastID Then
curRe = gcurLastBalance
End If
Else
curIn = DSum("[IN]", "TEST", "ID<=" & str(ID))
curOut = DSum("[OUT]", "TEST", "ID<=" & str(ID))
curRe = curIn - curOut
End If
' Debug.Print ID
glngLastID = ID
gcurLastBalance = curRe
GetBalance = curRe
Doerr:
End Function
'改變了 test 表的記錄值后,請調(diào)用此函數(shù)以強(qiáng)制 GetBalance 函數(shù)刷新.
Public Sub ResetBalance()
gcurLastBalance = 0
glngLastID = 0
End Sub
'這是 lwwvb 版主的函數(shù),我將它改為以 id 作為計算依據(jù)了,原理不變.
Public Function f(d As Long) As Currency
Dim a As Currency
Dim b As Currency
a = Nz(DSum("[in]", "test", "id <=" & str(d)))
b = Nz(DSum("[out]", "test", "id <=" & str(d)))
f = a - b
End Function
'請使用以下函數(shù)產(chǎn)生 600000 條隨機(jī)記錄,以檢驗函數(shù)在記錄較多時的效果.
Public Sub 產(chǎn)生隨機(jī)記錄()
Dim rst As DAO.Recordset
Dim i As Long
Debug.Print Now()
Set rst = CurrentDb.OpenRecordset("select [in] as dataa,[out] as datab from test")
For i = 0 To 600000
rst.AddNew
rst!dataa = CLng(Rnd() * 100)
rst!datab = CLng(Rnd() * 100)
rst.Update
Next i
rst.Close
Debug.Print Now()
End Sub
'一下是一組時間測試
Function t2()
Dim c1 As New class1
Dim rs As ADODB.Recordset
c1.Reset
Set rs = CurrentProject.Connection.Execute("SELECT [id], [in], [out], getbalance([id]) AS 余額 FROM test ORDER BY [id];")
Debug.Print c1.Elapsed
Set rs = Nothing
Set c1 = Nothing
End Function
Function t3()
Dim c1 As New class1
Dim rs As ADODB.Recordset
c1.Reset
Set rs = CurrentProject.Connection.Execute("SELECT [id], [in], [out], f([id]) AS 余額 FROM test ORDER BY [id]")
Debug.Print c1.Elapsed
Set rs = Nothing
Set c1 = Nothing
End Function
Function t1()
Dim c1 As New class1
Dim rs As ADODB.Recordset
c1.Reset
Set rs = CurrentProject.Connection.Execute("SELECT [id], [in], [out], (SELECT SUM(b.[in]-b.[out]) AS bb FROM test b WHERE a.[id] <= b.[id]) AS ye FROM test a ORDER BY [id]")
Debug.Print c1.Elapsed
Set rs = Nothing
Set c1 = Nothing
End Function

