BIGmiralli Frequent Poster
Joined: 17 Apr 2007 Posts: 38 Location: Boston, Massachusetts
|
Posted: Fri May 23, 2008 1:04 pm Post subject: Calculating the Weighted Median of a Recordset |
|
|
To calculate the weighted median of a set of numbers you need to find the median and if this number does not exist in the recordset take the average of the values above and below the median instead.
Weighted Median of 1,2,3,4,5 is 3 (Median is also 3)
Weighted Median of 1,2,3,4,5,6 is 3.5 (Median is also 3.5)
Weighted Median of 1,2,4,4,4,7,7,8,8,8 is 5.2 (((4+4+4) + (7+7))/5) (Median is 5.5)
The function below shows you how to calculate the weighted median in access. Paste the following into a new or existing module and call it from anywhere to get the weighted median of a field in any recordset.
Please note there is no error handling so make sure the field is a valid number and the recordset exists and has one or more records.
The test sub shows you how to call it. This was built in the Northwind database so you can use it there for test purposes.
Code: | Public Function WeightedMedianOfRst(RstName As String, fldName As String) As Double
'This function will calculate the weighted median of a recordset. The field must be a number value.
Dim MedianTemp As Double
Dim ThisValue As Double
Dim NumRecs As Long
Dim RstOrig As Recordset
Set RstOrig = CurrentDb.OpenRecordset(RstName, dbOpenDynaset)
RstOrig.Sort = fldName
Dim RstSorted As Recordset
Dim RstFiltered As Recordset
Set RstSorted = RstOrig.OpenRecordset()
If RstSorted.RecordCount Mod 2 = 0 Then
RstSorted.AbsolutePosition = (RstSorted.RecordCount / 2) - 1
ThisValue = RstSorted.Fields(fldName).Value
RstOrig.Filter = "[" & fldName & "] = " & ThisValue
Set RstFiltered = RstOrig.OpenRecordset()
MedianTemp = ThisValue * RstFiltered.RecordCount
NumRecs = RstFiltered.RecordCount
RstSorted.MoveNext
ThisValue = RstSorted.Fields(fldName).Value
RstOrig.Filter = "[" & fldName & "] = " & ThisValue
Set RstFiltered = RstOrig.OpenRecordset()
NumRecs = NumRecs + RstFiltered.RecordCount
MedianTemp = MedianTemp + ThisValue * RstFiltered.RecordCount
MedianTemp = MedianTemp / NumRecs
Else
RstSorted.AbsolutePosition = (RstSorted.RecordCount - 1) / 2
MedianTemp = RstSorted.Fields(fldName).Value
End If
WeightedMedianOfRst = MedianTemp
End Function
Private Sub test()
MsgBox MedianOfRst("Orders", "Freight")
End Sub |
________
Health Shop |
|