空手の形の試合の得点計算　～マクロ③ 順位をグループ分け～

昨日は、配列で順位を求める方法に挑戦した。結果、同点の場合は同じ順位を返すところまでを含めて、順位を求めることが出来た。

そこで今回は、同じ順位の中で更に順番を付ける方法を模索する。
f:id:Infoment:20181112211205p:plain

確認用のサンプルについて、少し点数を変えてみた。
f:id:Infoment:20181112211253p:plain

理由は、同じ順位のグループが一つとは限らないから。

作戦としては、↓ このような感じだ。

同じ順位毎に、グループを作る。一人でも一グループとする。
グループごとに、今まで除外していた点数を加えて、グループ内での順位を求める。
求めた順位を、同じだった順位に加えて１引く。

かなり複雑になってしまった。
まず辞書（連想配列）を用いて、グループがいくつあるか数えてみる。

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)

    ' ↓本日の追加個所。 
    Dim RankDict As Dictionary
    Set RankDict = New Dictionary    

        For i = 1 To UBound(Player)
            Player(i).Rank_1st = SQC.RankSeq(Player(i).Total_1st, TotalSeq_1st)
            If RankDict.Exists(Player(i).Rank_1st) Then
                RankDict(Player(i).Rank_1st) = RankDict(Player(i).Rank_1st) + 1
            Else
                RankDict(Player(i).Rank_1st) = 1
            End If
            RankCol.Add Player(i).Rank_1st
        Next
        
        MsgBox UBound(RankDict.Keys) + 1

End Sub