Функция вычисления медианы

 Вычисляет медиану для указанной таблицы или сохраненного запроса по заданному полю.
По использованию аналогична функциям DCount, DMax и т.п.
Option Compare Database
Option Explicit

Public Function DMedian(strNameFiels As String, strNameTBL As String, Optional strFilter As String = "") As Variant
'автор: osmor 27.11.2006 г.
'функция вычисления медианы
'использование аналогично DCount,DMax и т.п.
'strNameFiels - имя поля с данными
'strNameTBL - название таблицы или сохраненного запроса
'strFilter - строка фильтра
Dim dblrez As Double
Dim rst As ADODB.Recordset
Dim lngCount As Long
Dim lngTemp As Double
On Error GoTo Err_dMedian

   lngCount = Nz(DCount("*", strNameTBL, strFilter), 0)
   If lngCount = 0 Then DMedian = Null: Exit Function
   Set rst = New ADODB.Recordset
   rst.Open "select " & strNameFiels & " from " & strNameTBL & IIf(strFilter = "", "", "where " & strFilter) & " order by " & strNameFiels, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
   If (lngCount Mod 2) = 1 Then
    rst.AbsolutePosition = CLng(lngCount \ 2) + 1
    dblrez = Nz(rst.Fields(0), 0)
   Else
    rst.AbsolutePosition = CLng(lngCount \ 2)
    lngTemp = Nz(rst.Fields(0), 0)
    rst.MoveNext
    dblrez = (lngTemp + Nz(rst.Fields(0), 0)) / 2
   End If
   Set rst = Nothing
   DMedian = dblrez
Exit_dMedian:
    Exit Function

Err_dMedian:
    Select Case Err.Number
        Case Else
            MsgBox "(" & Err.Number & ") " & Err.Description & " в процедуре dMedian "
            Resume Exit_dMedian
    End Select

End Function

Рекомендовать страницу	Обсудить материал	Написать редактору
Распечатать страницу		Дата публикации: 19.07.2006