access如何实现动态查询余额

时　间:2009-01-06 08:34:42
作　者:UMVsoft整理   ID：1445  城市：上海
摘　要:Access如何实现动态查询余额
正　文:

表：

----------------------------------------------------------------

id 自动增加 长整

in 货币

out 货币

----------------------------------------------------------------

 

代码：

----------------------------------------------------------------

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 作为判断依据.(长整型)

 

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 表的记录值后,请调用此函数以强制 GetBalance 函数刷新.

 

Public Sub ResetBalance()

 

    gcurLastBalance = 0

    glngLastID = 0

End Sub

'这是 lwwvb 版主的函数,我将它改为以 id 作为计算依据了,原理不变.

 

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

 

'请使用以下函数产生 600000 条随机记录,以检验函数在记录较多时的效果.

 

Public Sub 产生随机记录()

    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

 

Access软件网QQ交流群 (群号:54525238) 　　　　　　Access源码网店