Calculating the Percentile of a Recordset
It's very easy to calculate
the percentile of a range of numbers in excel but access is a whole different
ball game.
The following code allows you to do just that and can be pasted
into either form code or a standalone module.
I've used the method of counting the number of records remove
one times by percentile add one to give me the record number I'm looking for,
which I believe is the exact way excel does it.
It will interpolate if the value being looked for exists between
two records.
Please note there is no error handling so make sure the fields
is a valid number and the recordset exists and has more than one record.
The test sub shows you how to call it.
Public Function PercentileRst(RstName As
String, fldName As String, PercentileValue As Double) As Double
'This function will calculate the percentile of a recordset.
'The field must be a number value and the percentile has to
'be between 0
and 1.
If PercentileValue < 0 Or PercentileValue > 1 Then
MsgBox "Percentile must be between 0 and 1", vbOKOnly
End If
Dim PercentileTemp As Double
Dim dbs As Database
Set dbs = CurrentDb
Dim xVal As Double
Dim iRec As Long
Dim i As Long
Dim RstOrig As Recordset
Set RstOrig = CurrentDb.OpenRecordset(RstName, dbOpenDynaset)
RstOrig.Sort = fldName
Dim RstSorted As Recordset
Set RstSorted = RstOrig.OpenRecordset()
RstSorted.MoveLast
RstSorted.MoveFirst
xVal = ((RstSorted.RecordCount - 1) * PercentileValue) + 1
'x now contains the record number we are looking for.
'Note x may not be whole number
iRec = Int(xVal)
xVal = xVal - iRec
'i now contains first record to look at and
'x contains diff to next
record
RstSorted.Move iRec - 1
PercentileTemp = RstSorted(fldName)
If xVal > 0 Then
RstSorted.MoveNext
PercentileTemp = ((RstSorted(fldName) - PercentileTemp) *
xVal) + PercentileTemp
End If
RstSorted.Close
RstOrig.Close
Set RstSorted = Nothing
Set RstOrig = Nothing
Set dbs = Nothing
PercentileRst = PercentileTemp
End Function
Private Sub test()
MsgBox PercentileRst("tbl_Main", "fld_Score", 0.95)
End Sub |
|