|
Функция вычисления персентили |
|
|
|
Автор Altu
|
|
28.11.2006 г. |
Вычисляет N-ю персентиль для указанной таблицы или сохраненного запроса по заданному полю. По использованию аналогична функциям DCount, DMax и т.п.
Public Function DPersent(strNameFields As String, strNameTBL As String, Optional strFilter As String = "", Optional p As Integer) As Variant
'автор: altu 28.11.2006 г.
'функция вычисления персентили
'использование аналогично DCount,DMax и т.п.
'strNameFields - имя поля с данными
'strNameTBL - название таблицы или сохраненного запроса
'strFilter - строка фильтра
'p - значение персентили в интервале 0-100
Dim rst As ADODB.Recordset
Dim lngCount As Long
Dim k, part, x1, x2 As Double
On Error GoTo Err_dPersent
lngCount = Nz(DCount("*", strNameTBL, strFilter), 0)
If lngCount = 0 Then DPersent = Null: Exit Function
Set rst = New ADODB.Recordset
rst.Open "select " & strNameFields & " from " & strNameTBL & IIf(strFilter = "", "", " where " & strFilter) & " order by " & strNameFields, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
If lngCount = 1 Then DPersent = Nz(rst.Fields(0), 0): Set rst = Nothing: Exit Function
k = p * (lngCount - 1) / 100 + 1
If (k / Int(k)) = 0 Or (k / Int(k)) = 1 Then
rst.AbsolutePosition = CLng(k)
DPersent = Nz(rst.Fields(0), 0)
Else
part = k - Int(k)
rst.AbsolutePosition = CLng(Int(k))
x1 = Nz(rst.Fields(0), 0)
rst.MoveNext
x2 = Nz(rst.Fields(0), 0)
DPersent = (1 - part) * x1 + part * x2
End If
Set rst = Nothing
Exit_dPersent:
Exit Function
Err_dPersent:
Select Case Err.Number
Case Else
MsgBox "(" & Err.Number & ") " & Err.Description & " в процедуре dMedian "
Resume Exit_dPersent
End Select
End Function
Просмотров: 10073
 Ваш коментарий будет первым | |
|
