VBA中位數函數

最近在做財務分析方面的開發，遇到了中位數據的問題，中位數在Excel中使用非常的方便，有現成的函數【Median】，直接拿來用就可以了，但在Access中該怎麼操作呢？

首先，我們先要了解一下什麼是中位數，百度詞條中是這樣解釋的：

中位數（Median）又稱中值，統計學中的專有名詞，是按順序排列的一組數據中居於中間位置的數，代表一個樣本、種羣或概率分佈中的一個數值，其可將數值集合劃分爲相等的上下兩部分。對於有限的數集，可以通過把所有觀察值高低排序後找出正中間的一個作爲中位數。如果觀察值有偶數個，通常取最中間的兩個數值的平均數作爲中位數。

定義：

中位數，又稱中點數，中值。中位數是按順序排列的一組數據中居於中間位置的數，即在這組數據中，有一半的數據比他大，有一半的數據比他小，這裏用 來表示中位數。（注意：中位數和衆數不同，衆數指最多的數，衆數有時不止一個，而中位數只能有一個。）

瞭解什麼是中位數，然後結合公式，我們就動手開發中位數了。我們以工資中位數做爲今天的示例。那麼有人就問了，爲什麼工資不取平均數呢？你想想，如果你和馬雲爸爸取一下平均數據，那是不是就不沒參考意思了，這個時候我們就要用中位數了。

中位數據函數，已經給大家寫好了，將下面的代碼添加到通用模塊

Public Function MedianNumber(ByVal strFile As String, ByRef strTable As String, Optional strWhere As String = "") As Single
    On Error GoTo ErrorHandler
    Dim strSQL As String
    Dim rst As Object
    Dim gCount As Long
    Dim strData As String
    Dim varData As Variant
    Dim varID As Variant
    Dim cnn As Object
    
    strSQL = "Select @strFile From @strTable  @Where Order By @strFile"
    strSQL = Replace(strSQL, "@strFile", strFile)
    strSQL = Replace(strSQL, "@strTable", strTable)
    
    If strWhere <> "" Then
        strSQL = Replace(strSQL, "@Where", " Where " & strWhere)
    Else
        strSQL = Replace(strSQL, "@Where", "")
    End If
    '        Debug.Print strSQL
    Set rst = CreateObject("ADODB.Recordset")
    Set cnn = CurrentProject.Connection
    rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
    '    Set rst = CurrentDb.OpenRecordset(strSQL)
    
    If rst.RecordCount > 0 Then
        gCount = rst.RecordCount
        rst.MoveFirst
    Else
        MedianNumber = 0
        GoTo ExitHere
    End If
    
 
    strData = ""
    Do Until rst.EOF
        strData = strData & rst.Fields(0) & ";"
        rst.MoveNext
    Loop
    rst.Close
'    Debug.Print strData
    varData = Split(strData, ";")

    If gCount Mod 2 <> 0 Then '判斷奇偶數
      
        MedianNumber = varData((UBound(varData) + 1) / 2 - 1) '如果是奇數據，中位數=X(n+1)/2，要注意下標，因爲數據的下標是從0開始
    Else
        '如果是偶數，中位數=(X(n/2)+X(n/2+1))/2
        MedianNumber = (Val(varData(UBound(varData) / 2 - 1)) + Val(varData(UBound(varData) / 2))) / 2
    End If
ExitHere:
    Set cnn = Nothing
    Set rst = Nothing
    Exit Function
ErrorHandler:
    MsgBoxEx Err.Description, vbCritical
    Resume ExitHere
    
End Function

最後，要和大家講的是，有些函數在Excel都是有現成的，但在Access中可能就需要自己來定義了，所以大家不要想當然的就在Access中使用，然後還問爲什麼在Excel可以，Access不能用這類的問題。

示例下載：
點擊查看示例
提取碼：itxk

更多關注公衆號