MS Access VBA：無需迭代記錄即可計算中位數

Question

我正試圖在Access中找到更快速的方式來計算我的中位數。您可以在下面的代碼中查看一次查詢一個項目代碼的位置，進行排序，然後計算中位數。有時候有600個物品代碼，這些物品可能每個都有1000多個與其相關的基地。例如，我正在使用的特定表格總共有15萬條記錄，並且速度非常慢。有沒有更好的方法來一次計算每個記錄中位數，而不是一次計算一個項目代碼。

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 

Answer 1

Access中沒有Median函數。 Excel有一個，但我相信它只限於30個數字，所以即使你想嘗試使用自動化功能，我也不相信它適用於你的情況。

我認爲你可能會通過微調你的函數並讓微軟的Jet Engine預編譯你的查詢來看到明顯的速度增加。

• 確保您已在表（S）
• 索引的基礎和代碼字段與具有標準參數 [何典]
• 與記錄優化功能，以構建代碼中創建參數查詢宣佈 變量和匹配字段類型（代碼=長整型???）

時間之前，所有這些變化之後，看看是否有任何明顯的差異

我糾正了一些可能不是拼寫錯誤的拼寫錯誤 - 我假定CODE是一個長整數 - 我可能又錯了。另外我的變化是由「前綴***************

創建預編譯參數查詢

創建新查詢稱爲 「qdfPrepMedian」

複製/粘貼SQL >>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