BIGmiralli Frequent Poster
Joined: 17 Apr 2007 Posts: 38 Location: Boston, Massachusetts
|
Posted: Fri May 23, 2008 12:31 pm Post subject: 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.
Code: | 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 |
Code: | Private Sub test()
MsgBox PercentileRst("tbl_Main", "fld_Score", 0.95)
End Sub |
Source: http://www.fabalou.com/Access/Modules/percentile.asp
________
Motorcycle Tires |
|