Hallo,
heute möchte ich euch zeigen wie man aus Werten einer Tabelle oder Abfrage den Median bestimmt. Laut Wikipedia ist die Definition für den Median einer Auflistung der Wert, der an der mittleren Stelle steht, wenn man die Werte der Größe nach sortiert.
Beispiel: 9;14;20;30;50 Der mittlere Wert der sortierten Auflistung ist hier die 20, also ist 20 der Median. Hat man eine gerade Anzahl an Werten, so gibt es keinen mittleren Wert, also nimmt man die beiden mittleren Werte der sortierten Auflistung und bildet daraus den Mittelwert. Beispiel: 9;14;20;30 Der Median berechnet sich hier aus (14 + 20) / 2, also 17.
Bildet man diese Vorschriften auf VBA Code ab, so ist zu unterscheiden zwischer gerader Anzahl Datensätze und ungerader. Dies lässt sich feststellen indem man durch 2 teilt und den ganzzahligen Rest sich ansieht. Das macht dankenswerter Weise die interne Methode Mod (Mod für Modulo) für uns.
Beispiele:
0 Mod 2 = 0
1 Mod 2 = 1
40 Mod 2 = 0
99 Mod 2 = 1
… usw.
Also überall wo 0 heraus kommt haben wir eine gerade Anzahl von Datensätzen. Aufpassen müssen wir bei der 0, also keine Datensätze. Wenn wir dies nicht beachten laufen wir in eine Fehlermeldung hinein.
So genug der Theorie, kommen wir man zum Code.

Public Function Median(ByVal TableName As String, ByVal FieldName As String) As Double
    Dim numDS As Long
    Dim lowerValue As Double
    Dim upperValue As Double
    Dim rst As DAO.Recordset

    Set rst = CurrentDb.OpenRecordset("Select " & FieldName & " From " & TableName & " Order By " & FieldName, dbOpenSnapshot)
    If Not rst.EOF Then
        With rst
            .MoveLast
            numDS = .RecordCount
            .MoveFirst
            If numDS Mod 2 = 0 Then
                .Move Int(numDS / 2) - 1
                lowerValue = .Fields(FieldName)
                .MoveNext
                upperValue = .Fields(FieldName)
                Median = (lowerValue + upperValue) / 2
            Else
                .Move Int(numDS / 2)
                Median = .Fields(FieldName)
            End If
        End With
        
        rst.Close: Set rst = Nothing
    Else
        rst.Close: Set rst = Nothing
        Err.Raise vbObjectError + 100, "Function Median", "Empty Recordset"
    End If
End Function

Der Funktion werden 2 Parameter übergeben, einen für den Tabellennamen bzw. den Namen der Abfrage, und einen für das Feldnamen von dem der Median berechnet werden soll.
Die Daten stellen wir in einem Recordset-Objekt zur Verfügung, worin diese auch gleich aufsteigend sortiert werden. Um die korrekte Anzahl von Datensätzen zu erhalten, muss der Datensatzzeiger ans Ende gesetzt werden.
Danach kommt die Entscheidung ob ganzzahlig oder nicht. Mal angenommen wir haben 27 Messwerte in der Tabelle. dann benötigen wir den 14. Wert. Also müssen wir den Datensatzzeiger um 13 Stellen von der ersten Position verschieben. Daher Int(numDS / 2) – 1. Bei 26 Messwerten benötigen wir den 13. und 14. Wert für die Mittelwertbildung. Das sind die Variablen lowerValue und upperValue. Also Datensatzzeiger um 26/2 -1 = 12 Datensätze verschieben. Beim upperValue brauchen wir einfach um 1 weiter gehen, daher Methode .MoveNext. Zu Schluss noch die üblichen Aufräumarbeiten die ja bei Recordsets bekannt sein sollten.

So jetzt noch der Fall dass das Recordset keine Datensätze liefern würde. Dann wird die äußere If-Verzweigung den Code übersprungen und zum Else-Teil wird ausgeführt. Dort schließen wir erstmal ordentlich das Recordset-Objekt und setzen es Nothing um das Objekt zu zerstören. Danach geben wir eine Fehlermeldung an die aufrufende Prozedur weiter die diese entsprechend verarbeiten kann.

Das wars auch schon, aufrufen kann man die Funktion aus einem Formular, Bericht, Modul oder auch Abfrage heraus.

Bis dahin
© 2015 Andreas Vogt

Comments are closed