MS Access VBA:计算中位数而不迭代记录

时间:2016-08-05 20:34:05

标签: sql ms-access access-vba

我正在尝试更快地计算Access中的中位数。你可以看到下面的代码,它一次查询一个项目代码,进行排序,然后计算中位数。有时会有600个商品代码,这些商品每个都有1000多个与之相关的基础。我正在使用的特定表格总共有150,000个记录,而且它的速度非常慢。是否有更好的方法可以同时计算每个记录中位数,而不是一次计算一个项目代码。

Function FIncPercentile(ByVal posCode As Single, ByVal k As Single, ByVal tbl As String) As Variant

Dim rstRec As Recordset
Dim db As Database
Dim n As Integer
Dim i As Single
Dim res, d1, d2 As Currency

' Create recordset from query
Set db = CurrentDb
Set rstRec = db.OpenRecordset("SELECT Co, Base " & _
                              "FROM " & tbl & " " & _
                              "WHERE Code = " & pos & " " & _
                              "ORDER BY Base ASC;")

' Skip if there are no matches
If IsNull(rstRec!base) Or rstRec.RecordCount = 0 Then
    FBasePercentile = Null
    Exit Function
End If

' Count records
rstRec.MoveLast
n = rstRec.RecordCount
rstRec.MoveFirst

' Calculate the index where k is the percentile
i = n * k

' Test the decimal and find value accordingly
If i = Int(i) Then
    rstRec.Move i - 1
    d1 = rstRec!base
    rstRec.MoveNext
    d2 = rstRec!base
    FIncPercentile = (d1 + d2) / 2
Else
    i = Round(i + 0.5, 0)
    rstRec.Move i - 1
    FIncPercentile = rstRec!base
End If

End Function

1 个答案:

答案 0 :(得分:2)

Access中没有中间函数。 Excel有一个,但我相信它只限于30个数字,所以即使你想尝试使用自动化功能,我也不相信它适用于你的情况。

我认为通过微调你的功能并让微软的Jet引擎预先编译你的查询,你可能会看到显着的速度提升。

  • 确保您的表格中包含索引的基本和代码字段
  • 使用具有criteria参数的Code创建参数查询 [什么代码]
  • 使用Recordset WITH构造优化您的函数,声明 变量和匹配的字段类型(Code = Long Integer ???)

在所有这些变化之前和之后计时,看看是否有任何明显的差异

我纠正了一些可能不是拼写错误的拼写错误 - 我假设CODE是一个长整数 - 我可能也错了。我的更改也以'***************

开头
  

创建预编译参数查询

创建名为“ qdfPrepMedian

的新查询

复制/粘贴SQL&gt;&gt; PARAMETERS [What Code] Long; SELECT Co, Base FROM <YourTableName> WHERE Code = [What Code] ORDER BY Base ASC;

保存查询

  

调整后的功能

Option Explicit

'***********************
' changed posCode to Long
'***********************
Function FIncPercentile(ByVal posCode As Long, ByVal k As Single, ByVal tbl As String) As Variant

    '***********************
    ' CREATE/USE Precompiled Parameter Query
    ' Create New Query called "qdfPrepMedian"
    ' Copy/Paste SQL >> PARAMETERS [What Code] Long; SELECT Co, Base FROM <YourTableName> WHERE Code = [What Code] ORDER BY Base ASC;

    Const QRY_BY_CODES  As String = "qdfPrepMedian"

    Dim qdf     As QueryDef
    '
    '***********************

    Dim rstRec  As Recordset
    Dim db      As Database
    Dim n       As Integer
    Dim i       As Single

    ' Declare all Currency variables on separate lines
    ' Otherwise they will be variants
    Dim res     As Currency
    Dim d1      As Currency
    Dim d2      As Currency

    Set db = CurrentDb

    '***********************
    ' Create readonly recordset from querydef
    Set qdf = db.QueryDefs(QRY_BY_CODES)
    qdf.Parameters("What Code") = posCode ' matches LONG variable passed to function
    Set rstRec = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly) ' Readonly is sometimes faster
    '***********************

    ' Use WITH rstRec
    With rstRec

        ' Skip if there are no matches
        If IsNull(!base) Or .RecordCount = 0 Then
        '*** Is this a type ***
        '    FBasePercentile = Null
        ' Should it BE
            FIncPercentile = Null
            Exit Function
        End If

        ' Count records
        .MoveLast
        n = .RecordCount
        .MoveFirst

        ' Calculate the index where k is the percentile
        i = n * k

        ' Test the decimal and find value accordingly
        If i = Int(i) Then
            .Move i - 1
            d1 = !base
            .MoveNext
            d2 = !base
            FIncPercentile = (d1 + d2) / 2
        Else
            i = Round(i + 0.5, 0)
            .Move i - 1
            FIncPercentile = !base
        End If

    End With

End Function