VBAプログラミングの応用

これまで学んだことと、さらに新しい知識を4つ加えて、ゲームのようなものを作ってみる。

新しい知識1:3つに分岐する条件分岐

3つに分岐する条件分岐を書くことができる。

【書き方】
 If 条件1 Then
	条件1が真の場合の処理
 ElseIf 条件2 Then
	条件1が偽で、条件2が真の場合の処理
 Else
	すべての条件が偽の場合の処理
 End If

これを使った例として、10行×10列の範囲でランダムに選んだセルの塗りつぶしの色が濃くなっていくマクロを作ってみる。
この例では、繰り返し処理によって行番号iと列番号jをそれぞれ1〜10の範囲で繰り返し、Rnd関数の答(0以上1未満のどれか)が0.2未満の場合だけ、セル(i, j)の色を変更している。
Sub 草が伸びる() For i = 1 To 10 For j = 1 To 10 If Rnd() < 0.2 Then If Cells(i, j).Interior.Color = RGB(255, 255, 255) Then '白なら Cells(i, j).Interior.Color = RGB(127, 255, 127) '薄緑にする ElseIf Cells(i, j).Interior.Color = RGB(127, 255, 127) Then '白ではなく薄緑なら Cells(i, j).Interior.Color = RGB(0, 255, 0) '緑にする Else '白でも薄緑でもないなら Cells(i, j).Interior.Color = RGB(0, 127, 0) '深緑にする End If End If Next j Next i End Sub

A列〜J列の幅を2.5程度にし、「Excelマクロ」の回で学んだ「ボタン(フォームコントロール)」を作って、このマクロを登録する。 ボタンを何度か押すと、ランダムに選ばれたセルの緑色が濃くなっていく。

草が伸びる


新しい知識2:セルをクリアする

セルの値と書式をクリアする方法である。

【書き方】
 Cells(行番号, 列番号).Clear
先ほどのマクロで色が付く範囲を簡単にクリアできるよう、次のマクロを作ってボタンに登録する。
Sub リセット() For i = 1 To 10 For j = 1 To 10 Cells(i, j).Clear 'クリアする Next j Next i End Sub

リセット


新しい知識3:プログラムの中でカスタム関数を使う

カスタム関数(ユーザー定義関数)は、プログラム中でも使うことができる。
まず、酔歩の関数を作る。座標値が与えられると、その1つ隣の座標(左か右)をランダムに答える関数である。
Function 酔歩(x, max) If Rnd() < 0.5 Then 酔歩 = x - 1 '1つ左に Else 酔歩 = x + 1 '1つ右に End If If 酔歩 < 1 Then '下限より小さくなったら 酔歩 = x '元の座標値 ElseIf 酔歩 > max Then '上限より大きくなったら 酔歩 = x '元の座標値 End If End Function
第2引数で範囲の上限を指定している。下限は1である。 左か右をランダムに選んだ結果、この範囲を外れてしまった場合は、元の座標値を答えるようにしている。 したがって、答が範囲外になることは決してない。

次に、10行x10列の範囲内のセルに「@」が入力されていたら、それを斜め方向に1つ移動するマクロを作る。
Sub 羊が移動する() For i = 1 To 10 For j = 1 To 10 If Cells(i, j).Value = "@" Then '@がいたら Cells(i, j).Value = "" '消す Tate = 酔歩(i, 10) '隣の行 Yoko = 酔歩(j, 10) '隣の列 Cells(Tate, Yoko).Value = "o" 'oを入力 End If Next j Next i For i = 1 To 10 For j = 1 To 10 If Cells(i, j).Value = "o" Then 'oがいたら Cells(i, j).Value = "@" '@にする End If Next j Next i End Sub
これもボタンに登録する。そして、セル範囲A1:J10のどれかに「@」を入力した上で、ボタンを何度か押す。

羊が移動する 羊が移動する 羊が移動する

酔歩関数で「@」の行番号と列番号をそれぞれ1つずつ増減している。行番号と列番号の両方を増減するので、必ず斜め方向へ移動する。ただし、「@」の座標値が下限(A列または第1行)の場合と上限(J列または第10行)の場合はその限りでない。 また、この図では「@」を1つのセルだけに入力したが、複数のセルに入力すれば全ての「@」が移動する。

新しい知識4:プログラムの中でマクロを使う

マクロも、プログラム中で使うことができる。

【書き方】
 Call マクロ名
これをCall文という。Call文でマクロを使うことを「マクロを呼び出す」と言う。
上で作った2つのマクロを呼び出すマクロを作ってみる。
Sub 草原の羊() Call 草が伸びる Call 羊が移動する End Sub
ボタンに登録し、セル範囲A1:J10のいくつかに「@」を入力した上で、ボタンを何度か押す。

草原の羊 草原の羊 草原の羊

なお、複数の「@」があると、時々2つが「合体」して1つになってしまうことがある(実際には、移動先に別の「@」があった場合に上書きされている)。 そのため、何度もボタンを押していると、だんだん「@」の数が減ってくる。

ボタンを20回押した例
草原の羊20回目


マクロを追加

さらに3つのマクロを順に追加する。
1つ目は、セルに「@」があったら、そのセルの色を白くするマクロである。
Sub 羊が草を食べる() For i = 1 To 10 For j = 1 To 10 If Cells(i, j).Value = "@" Then '@がいたら Cells(i, j).Interior.Color = RGB(255, 255, 255) '白にする End If Next j Next i End Sub
マクロ「草原の羊」に、このマクロを呼び出すCall文を追加する。
Sub 草原の羊() Call 草が伸びる Call 羊が移動する Call 羊が草を食べる End Sub
先ほどの状態から「草原の羊」のボタンを押すと、「@」のあるセルが白くなる。

草原の羊



2つ目は、セルに「@」があったら隣(右か左)のセルにも「@」を入力するマクロである。
マクロ「羊が移動する」をコピーして一部を変更するだけである。
Sub 羊が繁殖する() For i = 1 To 10 For j = 1 To 10 If Cells(i, j).Value = "@" Then '@がいたら Yoko = 酔歩(j, 10) '隣の列 Cells(i, Yoko).Value = "o" 'oを入力 End If Next j Next i For i = 1 To 10 For j = 1 To 10 If Cells(i, j).Value = "o" Then 'oがいたら Cells(i, j).Value = "@" '@にする End If Next j Next i End Sub
マクロ「草原の羊」に、このマクロを呼び出すCall文を追加する。
Sub 草原の羊() Call 草が伸びる Call 羊が移動する Call 羊が草を食べる Call 羊が繁殖する End Sub
先ほどの状態から「草原の羊」のボタンを押すと、移動先で「@」が増える。 何度もボタンを押すと、どんどん増えていく。

草原の羊 草原の羊 草原の羊


3つ目は、セルが白かったら、そのセルのデータを消去するマクロである。
マクロ「羊が草を食べる」の一部を変更するだけである。
Sub 羊が餓死する() For i = 1 To 10 For j = 1 To 10 If Cells(i, j).Interior.Color = RGB(255, 255, 255) Then '白なら Cells(i, j).Value = "" '消去する End If Next j Next i End Sub
マクロ「草原の羊」に、このマクロを呼び出すCall文を追加する。 「@の移動先のセルが白かったら消去する」という動作をさせたいので、追加する位置は「羊が移動する」の直後である。
Sub 草原の羊() Call 草が伸びる Call 羊が移動する Call 羊が餓死する Call 羊が草を食べる Call 羊が繁殖する End Sub
先ほどの状態から「草原の羊」のボタンを押すと、「@」が一度大きく減った後、増えたり減ったりするようになる。

草原の羊 草原の羊 草原の羊


最後に、マクロ「草が伸びる」の4行目の「Rnd() < 0.2」の右辺の数値を変更してみよう。 すると、緑色の増加率が変わり、「@」の増加とのバランスが変化する。 数値を0.1程度変更しただけでも、その後の推移が大きく変わるので、色々試してみてほしい。

以上