空手の形の試合の得点計算　～マクロ①～ - Infomentのブログ～Excel VBA奮闘記～

一昨日は、「空手の形の試合の得点から、ワークシート関数を用いて順位付けする計算式」を作成した。
infoment.hatenablog.com
今日は、マクロで順位を求めてみる。
f:id:Infoment:20181110173902p:plain
まず、計算方法をおさらいする。

主審１名と副審４名が採点する。
一人の持ち点は7.0点。そこから0.1点単位で、加点または減点する。
５名のうち、最高点と最低点を除く３名の合計点の大小で勝敗を決める。
上記に於いて同点の場合、合計点に最低点を加えて比較する。
それでも勝敗が決まらない場合、最高点を加えて比較する。

対象となる表は、こちらだ。事前に、テーブルとして書式設定済み。
f:id:Infoment:20181110173957p:plain

表の各行が、各選手の成績となっている。そこで、成績計算用のクラスモジュールを作成することにした。

クラスモジュール（KarateRankClass）

Option Explicit
' 選手の各情報を受け取る配列。
Public myRecord As Variant
' 一回目の順位。
Public Rank_1st As Long
' 二回目の順位。一回目の順位で同じ順位の人が居る場合のみ有効。
Public Rank_2nd As Long
' 三回目の順位。二回目の順位で同じ順位の人が居る場合のみ有効。
Public Rank_3nd As Long

選手名前

Property Get PlayerName() As String
    PlayerName = myRecord(1, 1)
End Property

その選手の最高点。配列内には選手の名前（文字列）も含まれているが、数字以外は無視してくれるらしい。

Property Get MaxPoint() As Double
    MaxPoint = WorksheetFunction.Max(myRecord)
End Property

その選手の最低点。

Property Get MinPoint() As Double
    MinPoint = WorksheetFunction.Min(myRecord)
End Property

５人の審判の採点合計。

Property Get Total_3rd() As Double
    With WorksheetFunction
        Total_3rd = .Round(.Sum(myRecord), 2)
    End With
End Property

最高点を除く４人の審判の採点合計。

Property Get Total_2nd() As Double
    With WorksheetFunction
        Total_2nd = .Round(Total_3rd - MaxPoint, 2)
    End With
End Property

最高点と最低点を除く、３人の審判の採点合計。

Property Get Total_1st() As Double
    With WorksheetFunction
        Total_1st = .Round(Total_2nd - MinPoint, 2)
    End With
End Property

次いで、テーブルの採点からランク付け用配列を作成する。

標準モジュール

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