空手の形の試合の得点計算　～マクロ⑤ 最終順位の決定～

昨日は、同じ順位の点数に最低点を加え、順位を求めることに挑戦した。
そこで今回は、それでも同じ順位の点数に最高点を加え、最終順位を求める方法を模索する。
f:id:Infoment:20181114222553p:plain

といっても、ロジックは昨晩完成している。作成前、あそこまでヤヤコシクなるとは思わなかったが、ヤヤコシクしたのは私だが、とにかく動いた。そこで今日は、サブプロシージャを４つに切り分けることにする。

モジュール変数宣言
メインのマクロ
最低点を加味した順位算出まで
最高点を加味した順位算出まで

本当は３と４で一つのユーザー定義関数にしたかったのだが、また脳みそが破裂しそうになったので、ちょっとズルをした。また、最初に準備したものの、作成の過程で使わなかった変数などの整理も行った。

標準モジュール

１．モジュール変数宣言

Option Explicit
    ' 各選手の成績を配列化。
    Dim Player() As KarateRankClass
    ' 最高点と最低点を除く合計点格納用配列。
    Dim TotalSeq_1st() As Variant
    ' 配列のソートなどに用いるクラスモジュール。
    Dim SQC As SeaquenceClass
    ' 同順位の人数確認用辞書。
    Dim RankDict As Dictionary
    ' ループカウンタ。
    Dim i As Long
    ' ループカウンタ。
    Dim j As Long
    ' 合計点の配列作成用コレクション。
    Dim col As Collection

２．メインのマクロ

Sub GetRank()
    Dim PointTable As ListObject
    Set PointTable = ActiveSheet.ListObjects("採点表")
    
    ' 順位のセルをリセット。
    PointTable.ListColumns("順位").DataBodyRange = ""

    ReDim Player(1 To PointTable.DataBodyRange.Rows.Count)
    ReDim TotalSeq_1st(1 To UBound(Player))
    
    ' 各選手のレコードから、各情報を取得。
        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
        Next

    Set SQC = New SeaquenceClass
        
        TotalSeq_1st = SQC.SortSeq(TotalSeq_1st, myDescending)
        
        Call GetRank2
        Call GetRank3
    
    ' 順位をセット
    For i = 1 To UBound(Player)
        PointTable.ListColumns("順位").DataBodyRange.Item(i) = Player(i).Rank_3rd
    Next        
End Sub

３．最低点を加味した順位算出まで

Sub GetRank2()

    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
        Next
    
        For i = 1 To UBound(Player)
            If RankDict.Exists(i) Then
                If RankDict(i) = 1 Then
                    For j = 1 To UBound(Player)
                        If Player(j).Rank_1st = i Then
                            Player(j).Rank_2nd = i
                            Exit For
                        End If
                    Next
                Else
                    Set col = New Collection
                    For j = 1 To UBound(Player)
                        If Player(j).Rank_1st = i Then
                            col.Add Player(j).Total_2nd
                        End If
                    Next
                    For j = 1 To UBound(Player)
                        If Player(j).Rank_1st = i Then
                            Player(j).Rank_2nd = Player(j).Rank_1st + SQC.RankSeq(Player(j).Total_2nd, SQC.ToArray(col)) - 1
                        End If
                    Next
                End If
            End If
        Next
End Sub

４．最高点を加味した順位算出まで

Sub GetRank3()

    Set RankDict = New Dictionary
    
        For i = 1 To UBound(Player)
            If RankDict.Exists(Player(i).Rank_2nd) Then
                RankDict(Player(i).Rank_2nd) = RankDict(Player(i).Rank_2nd) + 1
            Else
                RankDict(Player(i).Rank_2nd) = 1
            End If
        Next
    
        For i = 1 To UBound(Player)
            If RankDict.Exists(i) Then
                If RankDict(i) = 1 Then
                    For j = 1 To UBound(Player)
                        If Player(j).Rank_2nd = i Then
                            Player(j).Rank_3rd = i
                            Exit For
                        End If
                    Next
                Else
                    Set col = New Collection
                    For j = 1 To UBound(Player)
                        If Player(j).Rank_2nd = i Then
                            col.Add Player(j).Total_3rd
                        End If
                    Next
                    For j = 1 To UBound(Player)
                        If Player(j).Rank_2nd = i Then
                            Player(j).Rank_3rd = Player(j).Rank_2nd + SQC.RankSeq(Player(j).Total_3rd, SQC.ToArray(col)) - 1
                        End If
                    Next
                End If
            End If
        Next
End Sub