Public Function DMedian( _
ByVal strField As String, ByVal strDomain As String, _
Optional ByVal strCriteria As String) As Variant
Dim db As DAO.Database
Dim rstDomain As DAO.Recordset
Dim strSQL As String
Dim varMedian As Variant
Dim intFieldType As Integer
Dim intRecords As Integer
Const errAppTypeError = 3169
On Error GoTo HandleErr
Set db = CurrentDb()
varMedian = Null
strSQL = "SELECT " & strField & " FROM " & strDomain
If Len(strCriteria) > 0 Then
strSQL = strSQL & " WHERE " & strCriteria
End If
strSQL = strSQL & " ORDER BY " & strField
Set rstDomain = db.OpenRecordset(strSQL, dbOpenSnapshot)
intFieldType = rstDomain.Fields(strField).Type
Select Case intFieldType
Case dbByte, dbInteger, dbLong, _
dbCurrency, dbSingle, dbDouble, dbDate
If Not rstDomain.EOF Then
rstDomain.MoveLast
intRecords = rstDomain.RecordCount
rstDomain.MoveFirst
If (intRecords Mod 2) = 0 Then
rstDomain.Move ((intRecords \ 2) - 1)
varMedian = rstDomain.Fields(strField)
rstDomain.MoveNext
varMedian = _
(varMedian + rstDomain.Fields(strField)) / 2
If intFieldType = dbDate And Not IsNull(varMedian) Then
varMedian = CDate(varMedian)
End If
Else
rstDomain.Move ((intRecords \ 2))
varMedian = rstDomain.Fields(strField)
End If
Else
varMedian = Null
End If
Case Else
Err.Raise errAppTypeError
End Select
DMedian = varMedian
ExitHere:
On Error Resume Next
rstDomain.Close
Set rstDomain = Nothing
Exit Function
HandleErr:
DMedian = CVErr(Err.Number)
Resume ExitHere
End Function
Sorguya alana aşağıdaki gibi alan ekle
Medyan: Dmedian("[SAYI]";"Tablo1")