エクセルVBAでプログラミングをやってみようという人のための参考例として、食物連鎖や生態系をシミュレーションできるソフトを作成しました。あくまで、この記事はプログラミング重視の内容になっていて、食物連鎖のシミュレーションソフトとしては学校の自由研究程度であることをご了承頂ければと思います。m(__)m
ファイルをダウンロード
まず実際にエクセルファイルを使ってみたい方はこちらからダウンロードしてください。
ファイルを開いて「コンテンツの有効化」をクリックするとトップ画像のようになります。
※プログラム動作時に中止したい場合は、「Ctrl」+「Break」を押してください。
食物連鎖ルール
はじめにどのような食物連鎖ルールにするか決める必要があります。
ここで登場する動物などは下記の４種類とし、それぞれ増減するルールを決めます。また、シミュレーションする領域をここでは「アフリカ」としておきます。
ルールは以下の通りです。
ライオン
- ライオンの周囲にウサギがいれば、ライオンはウサギを食べライオンが１匹増える。
- アフリカ内のライオンは１日に３匹死んでしまう。
ウサギ
- ウサギの周囲に草があれば、ウサギは草を食べウサギが１匹増える。
- ライオンに食べられると死ぬ
- アフリカ内のウサギは２日で１匹死んでしまう。
草
- ウサギの周囲に草があれば、草は食べられてなくなる。
- 草はアフリカ内で１日１５増える
土
- ライオン、ウサギ、草がない何もない領域
ルールのイメージ図は下のようになります。
プログラミング
今回のシミュレーションではエクセルのセルの領域を利用して、その中で食物連鎖の様子を確認していきます。
具体的には５０×５０のセルの領域の中にライオン、ウサギ、草、土をランダムに配置し、条件に合致したときにそれぞれの個体を増減させるというものです。
ここでは土のセルを０、草を１、ウサギを２、ライオンを４とします。
それでは実際に増減例を見てみましょう。
増減例
ウサギ
これはウサギの右下に草があります。なので、ウサギの数が増えて、草が減ります。
ライオン
このケースはライオンの左上にウサギがいるケースです。ライオンが増えて、ウサギが減ることになります。
プログラミング構成
それでは実際にプログラミングコードを見てみましょう。プログラムの種類は全部で６つになります。「開発」⇒「マクロ」ボタンを開くとこのような画面になります。
この状態でいずれかのプログラムを選択し、編集をクリックするとソースコードが確認できます。ポイントのみですがそれぞれのソースコードを説明していきます。
P1_初期化
P1_初期化はライオンやウサギの総数をデフォルト値に戻す関数になります。
Sub P1_初期化()
Dim raion_kazu As Integer 'ライオンの数を定義
Dim usagi_kazu As Integer 'ライオンの数を定義
Dim kusa_kazu As Integer 'ライオンの数を定義
Dim tsuchi_kazu As Integer 'ライオンの数を定義
Worksheets("アフリカ").Cells(8, 69) = 30 'ライオンの初期数10匹
Worksheets("アフリカ").Cells(13, 69) = 50 'ウサギの初期数20匹
Worksheets("アフリカ").Cells(18, 69) = 300 '草の初期数300本
Worksheets("アフリカ").Cells(23, 69) = 0 '経過日数を0にする
P2_再配置
End Sub
P2_再配置
P2_再配置は50×50のマスの中にライオン、ウサギ、草、土をランダムに配置する関数になります。また、ここでライオン、ウサギ、草の上限数を超えた場合にはプログラムを停止するようにしています。
Sub P2_再配置()
Application.ScreenUpdating = False 'スクリーンの描写を停止
Dim raion_kazu As Integer
Dim usagi_kazu As Integer
Dim kusa_kazu As Integer
Dim tsuchi_kazu As Integer
Dim i As Integer
Dim j As Integer
Dim count As Integer
raion_kazu = Worksheets("アフリカ").Cells(8, 69) 'ライオンの数
usagi_kazu = Worksheets("アフリカ").Cells(13, 69) 'ウサギの数
kusa_kazu = Worksheets("アフリカ").Cells(18, 69) '草の数
If raion_kazu > 500 Then
MsgBox "ライオンの数は500以下にしてください"
End
End If
If usagi_kazu > 500 Then
MsgBox "うさぎの数は500以下にしてください"
End
End If
If kusa_kazu > 1000 Then
MsgBox "草の数は1000以下にしてください"
End
End If
'-----------土の場所を決定-------------
For i = 2 To 51
For j = 2 To 51
Worksheets("アフリカ").Cells(i, j) = 0 'すべて土（0）にする
Next
Next
'-----------草の場所を決定-------------
count = 0
While count < kusa_kazu
i = Int(50 * Rnd + 2)
j = Int(50 * Rnd + 2)
If Worksheets("アフリカ").Cells(i, j) = 0 Then 'ランダムに選んだセル位置が土(0)なら
Worksheets("アフリカ").Cells(i, j) = 1 '草にする
count = count + 1 '確定したセルの数を数える
End If
Wend
'-----------ウサギの場所を決定-------------
count = 0
While count < usagi_kazu
i = Int(50 * Rnd + 2)
j = Int(50 * Rnd + 2)
If Worksheets("アフリカ").Cells(i, j) = 0 Then 'ランダムに選んだセル位置が土(0)なら
Worksheets("アフリカ").Cells(i, j) = 2 'ウサギにする
count = count + 1 '確定したセルの数を数える
End If
Wend
'-----------ライオンの場所を決定-------------
count = 0
While count < raion_kazu
i = Int(50 * Rnd + 2)
j = Int(50 * Rnd + 2)
If Worksheets("アフリカ").Cells(i, j) = 0 Then 'ランダムに選んだセル位置が土(0)なら
Worksheets("アフリカ").Cells(i, j) = 3 'ライオンにする
count = count + 1 '確定したセルの数を数える
End If
Wend
P3_色塗り
Application.ScreenUpdating = True 'スクリーンの描写を許可
End Sub
P3_色塗り
P2_再配置の関数で場所が決まったら、視覚的にわかりやすいくするため色塗りを行います。それぞれの番号に応じた色を塗っていきます。
Sub P3_色塗り()
Application.ScreenUpdating = False 'スクリーンの描写を停止
Dim kazu As Integer
For i = 2 To 51
For j = 2 To 51
kazu = Worksheets("アフリカ").Cells(i, j) 'セルの数字を記憶する
Cells(i, j).Select 'セルを選択
Select Case kazu 'セルの数ごとにケース分け
Case 0 '土の場合
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 13434879
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Case 1 '草の場合
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 3394611
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Case 2 'ウサギの場合
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16751103
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Case 3 'ライオンの場合
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 204
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Select
Next
Next
Application.ScreenUpdating = True 'スクリーンの描写を許可
End Sub
P4_1日経過させる
ここがプログラムの一番重要なところになります。P4_1日経過させる 関数では周りのセルの状況を見て各個体を増やすか減らすかの判定を行っています。
また、冒頭の説明では省略したのですが、ライオンやウサギが増える条件に確率を付け加えています。理由としてはこの確率のパラメータで微調整しないとすぐにライオンやウサギが絶滅してしまうからです。
慣れている人は確率のパラメータを変更して挙動を確認してみるのもいいかと思います。
Sub P4_1日経過させる()
Dim i As Integer
Dim j As Integer
Dim day_kazu As Integer '経過日数
Worksheets("アフリカ").Cells(23, 69) = Worksheets("アフリカ").Cells(23, 69) + 1 '１日が経過
'----------ライオンの周りにウサギがいれば-----------------------
For i = 2 To 51
For j = 2 To 51
If Worksheets("アフリカ").Cells(i, j) = 3 Then 'ライオンが見つかった場合
'8方向をチェック
If Worksheets("アフリカ").Cells(i - 1, j - 1) = 2 Or _
Worksheets("アフリカ").Cells(i - 1, j) = 2 Or _
Worksheets("アフリカ").Cells(i - 1, j + 1) = 2 Or _
Worksheets("アフリカ").Cells(i, j - 1) = 2 Or _
Worksheets("アフリカ").Cells(i, j + 1) = 2 Or _
Worksheets("アフリカ").Cells(i + 1, j - 1) = 2 Or _
Worksheets("アフリカ").Cells(i + 1, j) = 2 Or _
Worksheets("アフリカ").Cells(i + 1, j + 1) = 2 Then
Worksheets("アフリカ").Cells(13, 69) = Worksheets("アフリカ").Cells(13, 69) - 1 'ウサギが食べられる
If Rnd > 0.77 Then '23%の確率
Worksheets("アフリカ").Cells(8, 69) = Worksheets("アフリカ").Cells(8, 69) + 1 'ライオンの数が増える
End If
End If
End If
Next
Next
'----------ウサギの周りに草があれば-----------------------
For i = 2 To 51
For j = 2 To 51
If Worksheets("アフリカ").Cells(i, j) = 2 Then 'ウサギが見つかった場合
'8方向をチェック
If Worksheets("アフリカ").Cells(i - 1, j - 1) = 1 Or _
Worksheets("アフリカ").Cells(i - 1, j) = 1 Or _
Worksheets("アフリカ").Cells(i - 1, j + 1) = 1 Or _
Worksheets("アフリカ").Cells(i, j - 1) = 1 Or _
Worksheets("アフリカ").Cells(i, j + 1) = 1 Or _
Worksheets("アフリカ").Cells(i + 1, j - 1) = 1 Or _
Worksheets("アフリカ").Cells(i + 1, j) = 1 Or _
Worksheets("アフリカ").Cells(i + 1, j + 1) = 1 Then
Worksheets("アフリカ").Cells(18, 69) = Worksheets("アフリカ").Cells(18, 69) - 1 '草の数が減る
If Rnd > 0.1 Then '90%の確率
Worksheets("アフリカ").Cells(13, 69) = Worksheets("アフリカ").Cells(13, 69) + 1 'ウサギが増える
End If
End If
End If
Next
Next
day_kazu = Worksheets("アフリカ").Cells(23, 69) '経過日数
'---------------------------------
If day_kazu Mod 1 = 0 Then '1日ごとに３匹死ぬ
Worksheets("アフリカ").Cells(8, 69) = Worksheets("アフリカ").Cells(8, 69) - 3
End If
If day_kazu Mod 3 = 0 Then '3日ごとに１匹死ぬ
Worksheets("アフリカ").Cells(13, 69) = Worksheets("アフリカ").Cells(13, 69) - 1
End If
'----------------草-----------------
Worksheets("アフリカ").Cells(18, 69) = Worksheets("アフリカ").Cells(18, 69) + 15 '1日で草が10つ増える
If Worksheets("アフリカ").Cells(8, 69) < 0 Then '値がマイナスになる場合は0にする
Worksheets("アフリカ").Cells(8, 69) = 0
End If
If Worksheets("アフリカ").Cells(13, 69) < 0 Then '値がマイナスになる場合は0にする
Worksheets("アフリカ").Cells(13, 69) = 0
End If
If Worksheets("アフリカ").Cells(18, 69) < 0 Then '値がマイナスになる場合は0にする
Worksheets("アフリカ").Cells(18, 69) = 0
End If
P2_再配置
End Sub
P5_100日経過させる
P5_100日経過させる 関数はP4_１日経過させる関数を１００回繰り返しているだけになります。連続でシミュレーションするときに使用します。
Sub P5_100日経過させる()
Dim i As Integer
For i = 1 To 100
P4_1日経過させる
Application.Wait Now() + TimeValue("00:00:01")
Next
End Sub
P6_1000日経過させる
こちらも同様にP4_１日経過させる関数を１０００回繰り返しているだけになります。
Sub P6_1000日経過させる()
Dim i As Integer
For i = 1 To 1000
P4_1日経過させる
Application.Wait Now() + TimeValue("00:00:01")
Next
End Sub
シミュレーション動作確認
それでは実際にシミュレーションしてみましょう。ダウンロードしたファイルはこのようになっています。
入力
黄色のセルで塗られた３か所にシミュレーションしたい数字を入力してください。デフォルトの値は推奨値です。ライオンとウサギの上限数は５００、草の上限数は１０００に設定しています。
ボタン
ボタンはリセットボタンと経過日数を指定するボタンがあります。リセットボタンを押すと経過日数が０にリセットされ、ライオン、ウサギ、草の数がデフォルト値に戻ります。
指定した経過日数に対応するボタンを押すとシミュレーションが開始されます。
デフォルトの数値だと５００日を過ぎたあたりからウサギの状況が苦しくなり、絶滅するケースが多く見られます。ソースコードを理解できた方は、自分でパラメータを変更してみてもいいかもしれません。
コメント