如何實現(xiàn)動態(tài)查詢余額

字號:

代碼:
    ----------------------------------------------------------------
    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