MS Access VBA: Berechnen Median ohne Iterieren durch Datensätze

Question

Ich versuche, eine schnellere Möglichkeit zu finden, meine Mediane in Access zu berechnen. Sie können den folgenden Code sehen, in dem jeweils ein Artikelcode abgefragt, sortiert und dann der Median berechnet wird. Manchmal gibt es 600 Artikelcodes und diese Artikel können jeweils über 1000 Basen zugeordnet werden. Die spezielle Tabelle, mit der ich arbeite, hat zum Beispiel 150.000 Datensätze und es geht wirklich langsam. Gibt es eine bessere Möglichkeit, den Median aller Datensätze gleichzeitig zu berechnen, im Gegensatz zu einem Artikelcode gleichzeitig?

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

Es gibt keine Median-Funktion in Access. Excel hat einen, aber ich glaube, es ist auf 30 Nummern beschränkt. Selbst wenn Sie also eine Automatisierungsfunktion verwenden wollten, glaube ich nicht, dass es für Ihren Fall funktionieren würde.

Ich denke, dass Sie eine spürbare Geschwindigkeitszunahme sehen können, indem Sie Ihre Funktion optimieren und Microsofts Jet Engine Ihre Abfrage vorkompilieren lassen.

• Achten Sie darauf, die Basis und-Code haben Felder in der Tabelle indiziert (n)
• erstellen Parameterabfrage mit Code, um das Kriterium Parameter mit [Was Code]
• Optimieren Sie Ihre Funktion mit Cord-MIT-Konstrukt , erklärt Variablen und angepasst Feldtypen (Code = Long Integer ???)

Zeit es vor und nach diesen Änderungen alle und sehen, ob es irgendwelche spürbaren Unterschied ist

Ich korrigierte ein paar Tippfehler, die keine Tippfehler sind - und ich nehme an, dass CODE eine lange Ganzzahl ist - was wiederum falsch ist. Auch sind meine Änderungen vorangestellte ‚***************

CREATE Precompiled Parameterabfrage

Neue Query anlegen namens "qdfPrepMedian"

Kopieren/Einfügen SQL >>PARAMETERS [What Code] Long; SELECT Co, Base FROM <YourTableName> WHERE Code = [What Code] ORDER BY Base ASC;

Speichern Sie die Abfrage

Adjusted Function

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