成績表の中から最高点を探して文字色変更や別のセルに書き出す方法

2024年5月29日

テストの成績表で各科目の点数の中から最高点を探す作業を、目で見て探して色を変更するのが面倒だと思って何かいい方法がないか？と探していますよね。

西船ボウルのリーグ成績表でも、参加者全員の各ゲームのスコアーの中からハイゲーム（HG）を一瞬で見つけ出す方法として、エクセルVBAを使って自動化しています。

使うエクセルVBA

VBA関数「WorksheetFunction」
検索「Find」
文字色「Font.Color」

たった6行だけの短い簡単なVBAコードを書くだけで、コマンドボタンを1クリックで一瞬でハイゲームを見つけ出してくれるので、あっという間にスタンディングが終わりますよ。

最高点を探して文字色変更

上の図のようにボウリング成績表があり、赤枠の中が参加者全員のボウリング3ゲームのスコアー全てです。

ここでは、自動的に赤枠のセルの範囲の中からハイゲーム（最高点）を見つけ出して、スコアーを赤色文字にするエクセルVBAコードをコマンドボタンに登録します。

HGを探して色付け

エクセルVBAでは、ハイゲーム（最高点）言い換えれば、「一番大きな数字」を探すのでMAX関数をVBAバージョンで使用して、一旦格納。

格納した数字のセルの場所を探して、見つけたら赤色文字にする流れです。

ピン君

次のようにエクセルVBAコードを書くと、自動的にセルC2からセルE8までの範囲の中から最大値を探して、見つけたら文字色を「赤色」に変更してくれます。

最高点を探し出して文字色変更

Sub ハイゲーム()
HG = WorksheetFunction.Max(Range(“C2:E8”))
Dim i As Range
Set i = Range(“C2:E8”).Find(What:=HG, LookAt:=xlWhole)
i.Font.Color = RGB(255, 0, 0)
End Sub

このエクセルVBAコードをコマンドボタンに登録すれば、1クリックするだけで完成です。

たまじい

では１行目から解説じゃ

「ハイゲーム」というタイトルでマクロ宣言
値「HG」は、セルC2～E8の範囲内の最大値を格納（見つけたハイゲームスコアー）
変数「i」Dimで宣言
「i」はセルC2～E8の範囲内で、格納値「HG」があるセル番地を指定する
指定したセル番地「i」の文字色を「赤色」にする
マクロ記録終了

ポイントは、エクセル関数で最大値を見つけるのは「MAX関数」で、ワークシート上で数式を使うと…

＝MAX(C2:E8)

ですが、エクセルVBAで使うと…

WorksheetFunction.Max(Range(“C2:E8”))

と、このように変わりますが、内容は一緒です。

では、次に見つけたHGのスコアーを別のセルへ記載させましょう。

HGを別のセルへ記載する

実は、HGを見つけて色を変えるよりも、別のセルに書き出す（記載する）VBAコードの方が簡単です。

ピン君

次のようにエクセルVBAコードを書くと、自動的にセルC2からセルE8までの範囲の中から最大値を探して、セルB16へ書き出します。

最高点を探して書き出す

Sub ハイゲーム書き出し()
Range(“B16”).Value = WorksheetFunction.Max(Range(“C2:E8”))
End Sub

色付けと異なり、「格納値」の部分を「書き出すセル番地」に書き換えただけで完成なので、変数や格納とかが不要になったので、とてもシンプルなエクセルVBAコードになりました。

ピン君

実際にこんな使い方しないでしょ！書き出したら、選手名も書き出すでしょ、足りないんじゃない！！

HGを探して名前と点数を書き出す

西船ボウルのリーグ成績表では、スコアーを入力していくと自動的にHG・HSなどを探し出して、セルに選手名とスコアーを表示するようになっていますので、自分の目で探すことはありません。

ピン君

実際の成績表ではHGやHSのセル行があるので、HG列（G列）に各選手のHGを表示しておいて、自動的にセルG列の中から最大値を探して、誰のスコアーなのかも探して、セルB16へスコアー、セルA16へ名前を書き出します。

HG探して該当者の名前とスコアーを書き出す

Sub ハイゲーム書き出し()
HG = WorksheetFunction.Max(Range(“G2:G8”))
Dim i As Range
Set i = Range(“G2:G8”).Find(What:=HG, LookIn:=xlValues)
i.Select
Range(“B16”).Value = i
Range(“A16”).Value = ActiveCell.Offset(0, -6).Value
If WorksheetFunction.CountIf(Range(“G2:G8”), i) >= 2 Then
MsgBox “重複”
Else
End If
End Sub

このエクセルVBAコードをコマンドボタンに登録すれば、1クリックするだけでハイゲームを探して、さらに該当者を照合して指定したセルに書き出してくれます。

たまじい

では１行目から解説じゃ