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

更多关注公众号