空手の形の試合の得点計算 ～マクロ② 配列のソート～

昨日は、
「空手の形の試合の得点から、ワークシート関数を用いて順位付けする計算式」
を作成した際、RANK関数で配列が使えず暗礁に乗り上げたところで終了した。

そこで今回は、配列で順位を求める方法を模索する。

今回の作戦は、↓ 以下の通り。

1. 配列を、降順でソートする。
2. 各合計値と配列内の値の大小関係を比較し、各人の順位を求める。

１．配列を、降順でソートする。

探してみたところ、配列内の値をソートする方法が、こちらのサイトで紹介されていた（ありがとうございます）。
vbabeginner.net

こちらを参考に、というかほぼ丸パクリで、いつものクラスモジュールに追加。

クラスモジュール（SeaquenceClass）

昇順・降順選択用の列挙型

Public Enum SortOrder
    myAscending
    myDescending
End Enum

配列ソート

Public Function SortSeq(seq As Variant, _
               Optional sort_type As SortOrder = myAscending) As Variant
    Dim aryList As Object
    Dim s As Variant
    Set aryList = CreateObject("System.Collections.ArrayList")
    
    For Each s In seq
        Call aryList.Add(s)
    Next
    
    Select Case sort_type
        Case myAscending
            ' 昇順でソート。
            Call aryList.Sort
        Case myDescending
            ' 昇順でソートののち、降順へ反転。
            Call aryList.Sort
            Call aryList.Reverse
    End Select
    
    SortSeq = aryList.ToArray    
End Function

配列をひっくり返すのも、Reverseの一撃で事足りる。何と便利なことか。
一方で、For Each ~ Next で繰り返しているため、元の配列が二次元であっても、戻り値が一次元配列となる。この辺りは、注意点と言えるかもしれない。

２．各合計値と配列内の値の大小関係を比較し、順位を求める。

上位から値を比較し、その人の合計が配列内の値以上になった時点を、その人の順位とする。

Public Function RankSeq(val As Double, seq As Variant) As Long
    Dim i As Long
        For i = LBound(seq) To UBound(seq)
            If val >= seq(i) Then
                Exit For
            End If
        Next
        ' 配列が０始まりになっているため、＋１する必要がある。
        RankSeq = i + 1
End Function

標準モジュール

これを昨日途中まで作成したサブプロシージャに追加してみる。

Sub GetRank()
    Dim PointTable As ListObject
    Set PointTable = ActiveSheet.ListObjects("採点表")
    
    ' 順位のセルをリセット。
    PointTable.ListColumns("順位").DataBodyRange = ""
    
    ' 各選手の成績を配列化。
    Dim Player() As KarateRankClass
    ReDim Player(1 To PointTable.DataBodyRange.Rows.Count)
    
    ' 最高点と最低点を除く合計点格納用配列。
    Dim TotalSeq_1st() As Variant
    ' 最高点を除く合計点格納用配列。
    Dim TotalSeq_2nd() As Variant
    ' 合計点格納用配列。
    Dim Totalseq_3rd() As Variant
    
    ReDim TotalSeq_1st(1 To UBound(Player))
    ReDim TotalSeq_2nd(1 To UBound(Player))
    ReDim Totalseq_3rd(1 To UBound(Player))
    
    ' 各選手のレコードから、各情報を取得。
    Dim i As Long
        For i = 1 To UBound(Player)
            Set Player(i) = New KarateRankClass
            Player(i).myRecord = PointTable.DataBodyRange.Rows(i)
            TotalSeq_1st(i) = Player(i).Total_1st
            TotalSeq_2nd(i) = Player(i).Total_2nd
            Totalseq_3rd(i) = Player(i).Total_3rd
        Next
    
' ↓ 本日追加した箇所。
    Dim SQC As SeaquenceClass
    Set SQC = New SeaquenceClass
        ' 配列を降順でソート。
        TotalSeq_1st = SQC.SortSeq(TotalSeq_1st, myDescending)
        
        For i = 1 To UBound(Player)
            ' 各自の順位を求める。
            Player(i).Rank_1st = SQC.RankSeq(Player(i).Total_1st, TotalSeq_1st)
            Debug.Print Player(i).Rank_1st & "：" & Player(i).PlayerName
        Next
End Sub

シート上で求めた結果と比較してみると、一致している。


現時点で２位が二人いる点も、きちんと反映されている。まずまずの結果だ。
この同じ順位が複数いる場合の対応について、次の仕掛けが必要になってきた。

次回に続きます。

参考まで。