Rambler's Top100
Российский фонд помощи
Навигация
Главная
MS ACCESS
VB
ASP
PHP
Наши друзья
Поиск
Форум
Лента новостей
Новый сайт

Online
Рассылки Subscribe.Ru
Работа с MS Access
Подписаться письмом
Реклама на сайте
 
Главная arrow MS ACCESS arrow Функция вычисления персентили
Функция вычисления персентили Печать E-mail
Автор Altu   
28.11.2006 г.
Вычисляет N-ю персентиль для указанной таблицы или сохраненного запроса по заданному полю. По использованию аналогична функциям DCount, DMax и т.п.

Public Function DPersent(strNameFields As String, strNameTBL As StringOptional strFilter As String = "", Optional p As IntegerAs 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 = NullExit 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 = NothingExit 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

Просмотров: 10072

  Ваш коментарий будет первым

Добавить коментарий
Имя:
E-mail
Коментарий:



Код:* Code

 
Реклама на сайте
HiProg.com - Технологии программирования
Rambler's Top100 TopList