by Johannes Weigel (1 Submission)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 29th May 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Median function Calculates the median of MS Access data sets
API Declarations
The difference to other median functions is the following: This module does not
calculate the median value of the values (rows) in a single field, but of the
values (colums) in a single data set, which is more complicated because you
can't simply work with recordsets (and sort values), but have to work with arrays
instead.
How to use the Median function?
Open an MS Access project. Create an empty module. Click File\Import file and import
this source code. Create a query with the values You want to calculate the median.
Use the following syntax when You execute the function from a query:
valueXY: Median("sourcetable",[sourcetable]![ID],number)
If the sourcetable is equivalent to the query from which You start MEDIAN,
You don't have to repeat the table name. The ID field has to be named ID.
Number means the number of fields which are not used in the median calculation.
Questions, remarks and bug reports to [email protected]
LICENSE AGREEMENT
Reservation of Ownership and Grant of Rights-This is a license agreement (Agreement) and not
an agreement for sale. The contributing author (hereinafter referred to as "Author") retains
exclusive title and ownership of the copy of the AML, SML, Avenue, AutoLISP, Visual Basic sample
scripts (collectively referred to hereinafter as "Script(s)") licensed under this Agreement and grants
you (hereinafter referred to as "Developer") a personal, nonexclusive, nontransferable, worldwide,
royalty-free license to use, copy, edit, modify, merge, incorporate, and/or prepare derivative work(s)
of the Script(s) with any new scripting code and/or data, and thereafter the copyright license to
demonstrate, reproduce, redistribute, and publicly display the derivative work(s) embedding the
Script(s) to Developer's clients for the client's own internal use. All rights not specifically granted in
this Agreement are reserved to the Author. In the event Developer transfers a copy of the
unmodified Script(s) to another party, Developer expressly agrees to always include this
Agreement file with all copies of the unmodified Scripts.
Copyright-The Script(s) are owned by the Author and are protected by United States copyright laws
and applicable international laws, treaties, and/or conventions. The following Author attribution
information must be given in comment form in the Script(s), in an "Help-About" dialog box, in a
supporting digital "Read Me" file, and/or provided in digital form for on-line documentation, and at
the beginning or end acknowledgment page of any hard-copy documentation:
"Portions of this work include intellectual property of Johannes Weigel and are used herein
with permission. Copyright (C) 2000 Johannes Weigel. All rights reserved."
The parties mutually agree that Developer may make an application for copyright registration in the
derivative work(s) prepared by Developer based on the preexisting Script(s) so long as Developer
identifies and discloses all respective ownership rights in preexisting material(s) that comprise
Developer's derivative work(s) in section 6, Derivative or Compilation on Form TX and/or any other
applicable form(s) of the United States Copyright Office or the applicable forms in other legal
jurisdictions.
Disclaimer of Warranty-Developer expressly acknowledges that the Script(s) are unsupported
scripting code and that no technical support shall be provided to Developer by the Author.
THE SCRIPT(S) ARE PROVIDED "AS-IS," WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, BY STATUTE OR OTHERWISE, INCLUDING, BUT NOT LIMITED TO ALL IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
AUTHOR DOES NOT WARRANT THAT THE OPERATION OF THE SCRIPTS SHALL BE
UNINTERRUPTED OR ERROR FREE. DEVELOPER BEARS ALL RISK AS TO THE QUALITY AND
PERFORMANCE OF THE SCRIPTS.
Exclusive Remedy and Limitation of Liability-The parties expressly agree that the Author's liability
hereunder for any damages to Developer, regardless of the form of action, shall not exceed the
total amount paid for the license granted herein.
IN NO EVENT SHALL THE AUTHOR BE LIABLE TO DEVELOPER FOR COSTS OF
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES, LOST PROFITS, LOST SALES OR
BUSINESS EXPENDITURES, INVESTMENTS, OR COMMITMENTS IN CONNECTION WITH ANY
BUSINESS, LOSS OF ANY GOODWILL, OR FOR ANY INDIRECT, SPECIAL, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING OUT OF THIS AGREEMENT OR USE OF THE SCRIPT(S),
HOWEVER CAUSED, ON ANY THEORY OF LIABILITY, AND WHETHER OR NOT THE AUTHOR
HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THESE LIMITATIONS SHALL
APPLY NOTWITHSTANDING ANY FAILURE OF ESSENTIAL PURPOSE OF ANY LIMITED REMEDY.
Governing Law-This license is governed by the laws of the United States of America and the state
laws of the Author without reference to conflict of laws principles.
Entire Agreement-The parties agree that this Agreement constitutes the sole and entire
agreement of the parties as to the matter set forth herein and supersedes any previous
agreements, understandings, and arrangements between the parties relating hereto when
Developer assents to be bound by these terms and conditions.
VBcoders
Option Explicit
'Median-Funktion (deutsch)
'Die Funktion MEDIAN berechnet in Access-Abfragen ein neues Feld mit den Medianwerten
'der Werte des Datensatzes. Der Median ist der "mittlere Wert" einer Datenreihe, also
'bspw für 1,2 und 100 die 2 oder für 1,2,3 und 100 die 2,5 (Mittelwert aus 2 und 3).
'Die Syntax der Funktion MEDIAN in einer Access-Abfrage ist folgendermaßen:
'WertXY: Median("quelltabelle",[quelltabelle]![ID],zahl), wobei das ID-Feld laufende
'Nummern enthalten und tatsächlich auch ID heißen muss. Zahl bezeichnet die Anzahl an
'Feldern (von links) in der Tabelle, die nicht zur Berechnung des Medians verwendet
'werden sollen oder können (bei Sielhautkataster: 88, nämlich ID, Probepunkt-Nr, Probe-Nr,
'Probenahme-Datum (zusammen 4), 42 übernommene Werte aus tab_Daten sowie 42 Vergleichs-
' werte aus tab_Vergleichswerte. Das neue Feld (WertXY) heißt k_mess.
'[email protected], 2001
'-----------------------------------------------------------------------------------
'Median function (english)
'The difference to other median functions is the following: This module does not
'calculate the median value of the values (rows) in a single field, but of the
'values (colums) in a single data set, which is more complicated because you
'can't simply work with recordsets (and sort values), but have to work with arrays
'instead.
'How to use the Median function?
'Open an MS Access project. Create an empty module. Click File\Import file and import
'this source code. Create a query with the values You want to calculate the median.
'Use the following syntax when You execute the function from a query:
'valueXY: Median("sourcetable",[sourcetable]![ID],number)
'If the sourcetable is equivalent to the query from which You start MEDIAN,
'You don't have to repeat the table name. The ID field has to be named ID.
'Number means the number of fields which are not used in the median calculation.
'Questions, remarks and bug reports to [email protected]
'------------------------------------------------------------------------------------
Function Median(tabelle As String, zeilenID As Integer, unusedFields As Integer) As Single
Dim MedianDB As DAO.Database
Dim MedianLine As DAO.Recordset
Dim number As Integer, str As String, thepos As Integer
Dim anzahl As Integer, element As Variant, rest As Byte, usedValues() As Boolean
Dim up As Double, down As Double, I As Integer, j As Integer
Dim downold As Double, delta As Double, deltaold As Double, nextelement As Integer
Set MedianDB = CurrentDb()
Set MedianLine = MedianDB.OpenRecordset("SELECT * " & _
"FROM [" & tabelle & "] WHERE [ID]=" & zeilenID)
anzahl = MedianLine.Fields.Count
ReDim values(anzahl - unusedFields)
Dim varArray As Variant
varArray = MedianLine.GetRows(zeilenID)
str = ""
I = 0 'Übertragen aus dem Recordset in das Array "values"
For Each element In varArray
I = I + 1
If I > unusedFields Then
values(I - unusedFields) = element
End If
Next element
anzahl = anzahl - unusedFields 'Nichtberücksichtigen der drei "Info"-Spalten
rest = anzahl Mod 2 'rest= 0 steht für gerade, 1 für ungerade
ReDim sortedValues(anzahl)
ReDim usedValues(anzahl)
up = 1
For I = 1 To anzahl
If values(I) > values(up) Then up = I
Next I
str = ""
'aufsteigendes Sortieren der Werte
For I = 1 To anzahl
down = up
For element = 1 To anzahl
If (values(element) < values(down)) And (usedValues(element) = False) Then _
down = element
Next element
sortedValues(I) = values(down)
usedValues(down) = True
Next I
If rest = 1 Then 'Zuweisen der Werte in der Mitte (Medianwerte)
Median = sortedValues((anzahl + 1) / 2)
Else
Median = (sortedValues(anzahl / 2) + sortedValues((anzahl + 2) / 2)) / 2
End If
MedianLine.Close
MedianDB.Close
End Function
'-----------------------------------------------------------------------------
'Portions of this work include intellectual property of Johannes Weigel and are used herein
'with permission. Copyright (C) 2000 Johannes Weigel. All rights reserved.
