EXCELで血統表を作ろう！レベル14

EXCELで血統表を作ろう！

レベル14 ますますすごいマクロに挑戦！その１

－５代血統表のインブリード馬を表示する－

【マクロの中のマクロ】

３代血統表のインブリード馬を表示するマクロには，同じような内容の記述が何度も出てきます．たとえば次のような部分です．

If S = DS And HORSE <> D Then
    RS.Select
        With Selection.Font
            .Name = "ＭＳゴシック"
            .FontStyle = "太字"
            .Size = 12
        End With
    RDS.Select
        With Selection.Font
            .Name = "ＭＳゴシック"
            .FontStyle = "太字"
            .Size = 12
        End With
End If

文字のフォントを変える記述が２回出てきますが（With Selection.Font から End With の部分），まったく同じ記述を２度書くのは面倒です．
また，If から End IF の部分は，同じ形式の記述がマクロ全体で３２回出てきますが，５代血統表では８００通り以上の数を書かなくてはならず，考えただけで気が遠くなりそうです．

そこで，まず小さいマクロを作っておき，このマクロをさらに大きなマクロの中で使うことにします．この方法なら，同じ記述を何度もしなくてすみます．

【フォントを変えるマクロ】

それでは１つ目の「小さいマクロ」，フォントを変えるマクロを記述してみましょう．

Sub ChangeFont(InbreedHorse As Range)

'馬名のフォントを変更する

With InbreedHorse.Font
    .Name = "ＭＳゴシック"
    .FontStyle = "太字"
    .Size = 12
End With

End Sub

今まで記述したマクロは，“Sub インブリード3代( ) ”のように，かっこ ( ) の中には何も記述しませんでしたが，上の例では“InbreedHorse”という変数が入っています．
これは，マクロを関数のように使うときの記述の仕方で，変数に代入された値を使って記述された操作を行うということです．

このように，フォントを変える部分をマクロにしておけば，
フォントを変更する記述

    RS.Select
        With Selection.Font
            .Name = "ＭＳゴシック"
            .FontStyle = "太字"
            .Size = 12
        End With

を，

ChangeFont RS

の１行ですますことができます．

【インブリード馬を探すマクロ】

今度は血統表の中からインブリード馬を探すマクロの記述です．
馬を親子の組にし，組同士で比較して，親が同じで子が異なるとき，親をインブリード馬と見なしてフォントを変更します．

Sub NameCheck(RC1 As Range, RP1 As Range, _
RC2 As Range, RP2 As Range)

'馬名を調べ，インブリードの時フォントを変更する
'C=子，P=親

Dim C1 As String
Dim P1 As String
Dim C2 As String
Dim P2 As String

C1 = RC1.Value
P1 = RP1.Value
C2 = RC2.Value
P2 = RP2.Value

If P1 = P2 And C1 <> C2 Then
ChangeFont RP1: ChangeFont RP2
End If

End Sub

先に作ったマクロ“ChangeFont”を使って，インブリード馬のフォントを変更します．
このマクロを使うと，インブリード馬を探す記述は次のようになります．

NameCheck RHORSE, RS, RD, RDS

これなら８００通りの検索を記述しても楽ですよね．（そうでもないか．．．）

【メインのマクロ】

いよいよメインのマクロを書いていきます．
内容は“インブリード３代”と基本的には同じですが，４代目～５代目の分を追加する必要があります．“Sub インブリード３代 ( )”をコピーして記述を追加していきましょう．

Sub インブリード5代( )

'５代血統表中のインブリード馬のフォントを変更する

Application.ScreenUpdating = False

'表全体のフォントを初期化する

Range("A3:J34").Select
With Selection.Font
    .Name = "ＭＳ明朝"
    .FontStyle = "標準"
    .Size = 11
End With

フォントの名前は“インブリード５代”とします．
コメント行の下に

Application.ScreenUpdating = False

という記述がありますが，これは，範囲を選択したりセルを移動したりするときに，画面が反転したりちらちらするのを止める操作です．
記述しなくてもプログラムそのものには影響ありませんが，マクロを動かすたびにちらちらするのはうっとうしいので，これを書いておきましょう．
なお，プログラムの最後には

Application.ScreenUpdating = True

という記述を入れて，元に戻しておきます．

次に表全体のフォントを初期化しますが，表が５代に広がったので，初期化する範囲を“A3:J34”に変更します．

'表中の馬名に変数を設定する
'S=父，D=母

'０代目
Dim RHORSE As Range

'１代目
Dim RS As Range
Dim RD As Range

'２代目
Dim RSS As Range
Dim RSD As Range
Dim RDS As Range
Dim RDD As Range

    ・
    ・
    ・

'５代目
Dim RSSSSS As Range
Dim RSSSSD As Range
Dim RSSSDS As Range

    ・
    ・
    ・

Dim RDDDSD As Range
Dim RDDDDS As Range
Dim RDDDDD As Range

これもかなり面倒ですが，血統表の馬名が表示されているすべてのセルに変数を設定，宣言します．
変数名の付け方は，“インブリード３代”マクロと同じようにします．

'変数に値を代入する

'０代目
Set RHORSE = Range("B1")

'１代目
Set RS = Range("B13")
Set RD = Range("B24")

'２代目
Set RSS = Range("D8")
Set RSD = Range("D13")
Set RDS = Range("D24")
Set RDD = Range("D29")

    ・
    ・
    ・

'５代目
Set RSSSSS = Range("J3")
Set RSSSSD = Range("J4")
Set RSSSDS = Range("J5")

    ・
    ・
    ・

Set RDDDSD = Range("J32")
Set RDDDDS = Range("J33")
Set RDDDDD = Range("J34")

変数にセル範囲を代入していきます．まちがえないよう注意して，すべてのセル範囲を代入してください．

'インブリードかどうか調べる

NameCheck RHORSE, RS, RD, RDS
NameCheck RHORSE, RS, RDS, RDSS
NameCheck RHORSE, RS, RDD, RDDS
NameCheck RHORSE, RS, RDSS, RDSSS
NameCheck RHORSE, RS, RDSD, RDSDS

    ・
    ・
    ・

NameCheck RDDSD, RDDSDD, RDDDS, RDDDSD
NameCheck RDDSD, RDDSDD, RDDDD, RDDDDD
NameCheck RDDDS, RDDDSS, RDDDD, RDDDDS
NameCheck RDDDS, RDDDSD, RDDDD, RDDDDD

メインのインブリード馬の検索部分です．
これはもう，ひたすら上から順にすべての組合せを記述していくしかありません．まちがいや漏れがあるとインブリードが正しく表示されませんので，がんばって記述してください．

Range("B2").Select

Application.ScreenUpdating = True

End Sub

お疲れさまでした．最後に“B2”セルを選択してマクロを終了させます．

次のレベル１５では，いろいろなインブリードを持つ馬のデータを追加し，表示が正しく行われるか確認してみます．
３代血統表の時より，さらに大きな感動が待っている．．．はずなんですが．．．

レベル１５へ

EXCELで血統表を作ろう！目次へ

トップページへ