Visual Basicの質問です（というかなんというか）

大変お待たせ致しました。いやぁ、いざやってみると結構複雑でした。

Excelでサンプルデータを作ってテストしたので、多分間違っていないと思いますが、

確信は無いのでi_kumagoroさんの方法で計算した方が間違えがなくて確実かも。

前述の通り、平均値を求めて、そこから中央値に近付く方法で組んでみました。

件数が多ければ早く処理できると思うのですが...。

ちなみに偶数の場合は2つの平均というのが無ければ、もっと楽なんですけどね...。

自己満足で作りましたがご参考まで。

Function medianVB()
Dim i As Integer 'カウンタ
Dim ic As Integer '無限ループ対策
Dim av As Double '平均値
Dim ma As Double '最大値
Dim mi As Double '最小値
Dim cc As Integer '大きい値から数えた中央値の位置
Dim tp As Integer '件数が偶数なら1、奇数なら0
Dim mm As Double 'ターゲット値
Dim m1 As Double '中央値1
Dim lc As Integer '該当する個数
Dim sc As Integer '同じ値の個数
Dim rd As Integer 'データ読み込み用
Dim sr As Boolean
    Open "med.txt" For Input As #1
    
    i = 0
    av = 0
    ma = 1000
    mi = 0
    '件数,平均値,最大値を求める
    Do Until EOF(1)
        Input #1, rd
        av = av + rd
        i = i + 1
    Loop
    cc = i
    av = av / cc
    tp = (cc + 1) Mod 2
    cc = Int((cc + 1) / 2)
    
    '平均値よりも大きい最小の値を探す
    mm = FindNextNum(av, sc, lc, ma, True)
    If cc <= lc And cc >= (lc - sc) Then
        If (tp = 0) Or (tp = 1 And ((cc + tp) <= lc)) Then
            '探した値が中央値の時
            medianVB = mm
            Close
            Exit Function
        Else
            '探した値と次の値が中央値の時
            m1 = mm
            mm = FindNextNum(m1, sc, lc, mi, False)
            medianVB = (m1 + mm) / 2
            Close
            Exit Function
        End If
    Else
        If cc < lc Then
            sr = True
        Else
            sr = False
            ma = mi
        End If
        ic = 0
        Do
            mm = FindNextNum(mm, sc, lc, ma, sr)
            If cc <= lc And cc >= (lc - sc) Then
                If (tp = 0) Or (tp = 1 And ((cc + tp) <= lc)) Then
                    medianVB = mm
                    Close
                    Exit Function
                Else
                    m1 = mm
                    mm = FindNextNum(m1, sc, lc, mi, False)
                    medianVB = (m1 + mm) / 2
                    Close
                    Exit Function
                End If
            End If
            ic = ic + 1
            If ic > cc Then
                Stop
            End If
        Loop
    End If
End Function
Function FindNextNum(tn As Double, sc As Integer, lc As Integer, ByVal mm As Integer, sr As Boolean) As Integer
'tn:基準値
'sc:FindNextNumと同値の個数-1
'lc:該当する個数
'mm:最大値/最小値
'sr:True=基準値よりも大きい数値を探す
Dim rd As Integer
    
    Seek 1, 1
    sc = 0
    lc = 0
    Do Until EOF(1)
        Input #1, rd
        If sr Then
            If tn < rd Then
                lc = lc + 1
                If mm > rd Then
                    mm = rd
                    sc = 0
                ElseIf mm = rd Then
                    sc = sc + 1
                End If
            End If
        Else
            If tn > rd Then
                If mm < rd Then
                    mm = rd
                    sc = 0
                ElseIf mm = rd Then
                    sc = sc + 1
                End If
            Else
                lc = lc + 1
            End If
        End If
    Loop
    If sr = False Then
        lc = lc + sc + 1
    End If
    FindNextNum = mm
End Function