Ôóíêöèÿ âû÷èñëåíèÿ ìåäèàíû

osmor

 Âû÷èñëÿåò ìåäèàíó äëÿ óêàçàííîé òàáëèöû èëè ñîõðàíåííîãî çàïðîñà ïî çàäàííîìó ïîëþ.
Ïî èñïîëüçîâàíèþ àíàëîãè÷íà ôóíêöèÿì 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

 


Ñòðàíèöà ñàéòà http://silicontaiga.ru
Îðèãèíàë íàõîäèòñÿ ïî àäðåñó http://silicontaiga.ru/home.asp?artId=6229