VBAで中央値を求める｜ Excel作業をVBAで効率化

VBAで中央値を求める方法

Excelではワークシート関数のMEDIAN関数を使うと中央値が求められます。

VBAで中央値を求めたい場合はこのMEDIAN関数を使うのが一番簡単です。またほとんどの場合において一番高速です。

ただ、どうしてもVBAの処理で算出したい場合もあるかもしれません。

この２つの中央値を求める方法について紹介します。

中央値の考え方

簡単にですが、中央値の考え方を説明します。

中央値は昇順もしくは降順で並んだ値の中で中央にある値を指します。

並んでいる値の個数が偶数の場合は中央が２つ存在するためその場合はその２つの平均を中央値とします。

（1, 3, 4, 6, 100）という5個の値の場合、中央値は4になります。

（1, 3, 4, 6, 7, 100）という6個の値の場合、中央値は4 + 6の10を半分に割った5になります。

（1, 1, 1, 1, 1, 100）という6個の値の場合、中央値は1 + 1の2を半分に割った1になります。

ワークシート関数のMEDIAN関数を使う方法

ワークシート関数のMEDIAN関数を使う方法です。

引数に値が入った配列を渡します。

引数配列内に数値でない値は内部処理で除去し、数値のみでMEDIAN関数を実行します。

Function GetMedian1(a_ar())
    Dim ar()                    '// 引数配列から数値のみを抽出した配列
    Dim v                       '// 配列値
    Dim ret                     '// 戻り値
    Dim s                       '// 文字列
    
    ReDim ar(0)
    
    '// 数値以外を除去
    For Each v In a_ar
        '// 数値の場合
        If (IsNumeric(v) = True And IsEmpty(v) = False) Then
            ar(UBound(ar)) = Val(v)
            ReDim Preserve ar(UBound(ar) + 1)
        End If
    Next
    
    '// 配列に格納済みの場合
    If IsEmpty(ar(0)) = False Then
        '// 余分な領域を削除
        ReDim Preserve ar(UBound(ar) - 1)
    End If
    
    If IsEmpty(ar(0)) = True Then
        Set GetMedian1 = Nothing
        Exit Function
    End If
    
    '// MEDIAN関数の引数をカンマ編集
    For Each v In ar
        If s <> "" Then
            s = s & ","
        End If
        
        s = s & v
    Next
    
    '// MEDIAN関数を実行
    ret = Application.Evaluate("MEDIAN(" & s & ")")
    
    GetMedian1 = ret
End Function

Function GetMedian1(a_ar())

Dim ar() '// 引数配列から数値のみを抽出した配列

Dim v '// 配列値

Dim ret '// 戻り値

Dim s '// 文字列

ReDim ar(0)

'// 数値以外を除去

For Each v In a_ar

'// 数値の場合

If (IsNumeric(v) = True And IsEmpty(v) = False) Then

ar(UBound(ar)) = Val(v)

ReDim Preserve ar(UBound(ar) + 1)

End If

'// 配列に格納済みの場合

If IsEmpty(ar(0)) = False Then

'// 余分な領域を削除

ReDim Preserve ar(UBound(ar) - 1)

End If

If IsEmpty(ar(0)) = True Then

Set GetMedian1 = Nothing

Exit Function

End If

'// MEDIAN関数の引数をカンマ編集

For Each v In ar

If s <> "" Then

s = s & ","

End If

s = s & v

'// MEDIAN関数を実行

ret = Application.Evaluate("MEDIAN(" & s & ")")

GetMedian1 = ret

End Function

利用方法

Sub GetMedianTest()
    Dim ar()
    
    ReDim ar(6)
    
    ar(0) = 6
    ar(1) = 3
    ar(2) = 5
    ar(4) = 10
    ar(5) = -4
    
    Debug.Print GetMedian1(ar)
End Sub

Sub GetMedianTest()

Dim ar()

ReDim ar(6)

ar(0) = 6

ar(1) = 3

ar(2) = 5

ar(4) = 10

ar(5) = -4

Debug.Print GetMedian1(ar)

End Sub

実行結果
5

VBAの処理で中央値を算出する方法

ワークシート関数のMEDIAN関数を使わない方法です。

.NET FrameworkのArrayListクラスを利用するために場合によっては参照設定が必要な場合があります。

VBA画面のツールメニュー→参照設定で以下の選択もしくは参照してください。
C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb（dllではありません）
Microsoft Common Language Runtime Class Library

参照してもチェックが付かない場合がありますが、その場合は参照設定が不要ですので気にせず未設定で構いません。

引数配列から数値のみを抽出しているのは上の関数と同じですが、そのあとで配列のソートをArrayListクラスのSortメソッドで行っています。

この部分はクイックソートなどの他のソート方法でも構いません。

ソートを行っている理由は、ソート後であれば配列の中央が分かるためです。

参考としてコードは紹介しましたが、やはりMEDIAN関数の方をお勧めします。

Function GetMedian(a_ar())
    Dim ar()                    '// 引数配列から数値のみを抽出した配列
    Dim v                       '// 配列値
    Dim ret                     '// 戻り値
    Dim iHalf                   '// 配列要素の半分
    Dim iCount
    
    ReDim ar(0)
    
    '// 数値以外を除去
    For Each v In a_ar
        '// 数値の場合
        If (IsNumeric(v) = True And IsEmpty(v) = False) Then
            ar(UBound(ar)) = Val(v)
            ReDim Preserve ar(UBound(ar) + 1)
        End If
    Next
    
    '// 配列に格納済みの場合
    If IsEmpty(ar(0)) = False Then
        '// 余分な領域を削除
        ReDim Preserve ar(UBound(ar) - 1)
    End If
    
    '// ソート
    Call ArrayListSort(ar)
    
    If IsEmpty(ar(0)) = True Then
        Set GetMedian = Nothing
        Exit Function
    End If
    
    iCount = UBound(ar)
    iHalf = Fix(iCount / 2)
    
    '// 偶数の場合
    If (iCount + 1) Mod 2 = 0 Then
        '// 配列の中央２つの値の平均
        ret = (ar(iHalf) + ar(iHalf + 1)) / 2
    '// 奇数の場合
    Else
        '// 配列の中央の値
        ret = ar(iHalf)
    End If
    
    GetMedian = ret
End Function

Sub ArrayListSort(ary() As Variant)
    Dim aryList As Object   '// ArrayList
    Dim s                   '// 文字列
    
    '// .NET FrameworkのArrayListクラスを利用する
    Set aryList = CreateObject("System.Collections.ArrayList")

    '// 配列をArrayListにコピー
    For Each s In ary
        Call aryList.Add(s)
    Next
    
    '// 並べ替え
    Call aryList.Sort
    
    '// 配列に再格納
    ary = aryList.ToArray
End Sub

Function GetMedian(a_ar())

Dim ar() '// 引数配列から数値のみを抽出した配列

Dim v '// 配列値

Dim ret '// 戻り値

Dim iHalf '// 配列要素の半分

Dim iCount

ReDim ar(0)

'// 数値以外を除去

For Each v In a_ar

'// 数値の場合

If (IsNumeric(v) = True And IsEmpty(v) = False) Then

ar(UBound(ar)) = Val(v)

ReDim Preserve ar(UBound(ar) + 1)

End If

'// 配列に格納済みの場合

If IsEmpty(ar(0)) = False Then

'// 余分な領域を削除

ReDim Preserve ar(UBound(ar) - 1)

End If

'// ソート

Call ArrayListSort(ar)

If IsEmpty(ar(0)) = True Then

Set GetMedian = Nothing

Exit Function

End If

iCount = UBound(ar)

iHalf = Fix(iCount / 2)

'// 偶数の場合

If (iCount + 1) Mod 2 = 0 Then

'// 配列の中央２つの値の平均

ret = (ar(iHalf) + ar(iHalf + 1)) / 2

'// 奇数の場合

Else

'// 配列の中央の値

ret = ar(iHalf)

End If

GetMedian = ret

End Function

Sub ArrayListSort(ary() As Variant)

Dim aryList As Object '// ArrayList

Dim s '// 文字列

'// .NET FrameworkのArrayListクラスを利用する

Set aryList = CreateObject("System.Collections.ArrayList")

'// 配列をArrayListにコピー

For Each s In ary

Call aryList.Add(s)

'// 並べ替え

Call aryList.Sort

'// 配列に再格納

ary = aryList.ToArray

End Sub

利用方法

Sub GetMedianTest()
    Dim ar()
    
    ReDim ar(6)
    
    ar(0) = 6
    ar(1) = 3
    ar(2) = 5
    ar(4) = 10
    ar(5) = -4
    
    Debug.Print GetMedian1(ar)
End Sub

Sub GetMedianTest()

Dim ar()

ReDim ar(6)

ar(0) = 6

ar(1) = 3

ar(2) = 5

ar(4) = 10

ar(5) = -4

Debug.Print GetMedian1(ar)

End Sub

実行結果
5

VBAで中央値を求める方法

中央値の考え方

ワークシート関数のMEDIAN関数を使う方法

利用方法

VBAの処理で中央値を算出する方法

利用方法

関連記事