Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Mac OS X : Excel 2016)
人の移動および滞留
投稿日時: 19/09/20 09:03:35
投稿者: ペイしん

 
VBA初心者です。
人の移動および滞留をモデルとしたシミュレーションを作ろうとしています。
赤ブロックの人が右に移動し続け、荷物置場に見立てた黄緑色のブロックの上に来ると止まる。
黄緑色のブロックに着くと、黄緑色のブロックの下に薄緑色のブロックが出現し、それが4つ下に行ったところで消滅し、それと共に黄緑ブロック上の赤ブロックも消滅します。
赤ブロックの人の後ろにはグレーブロックがあり、グレーブロックに赤ブロックが隣り合わせになると止まる仕組みになっています。
この流れで人の移動と荷物置場による滞留をイメージしているのですが、以下の問題が発生しています。
 
・インデックスが有効でないとのエラーが出る
⇒自分なりには境界条件は守ってると思ってます、コードを一部切り取って実行して、また元に戻して実行するとこのエラーが消えたりして謎です。
・白⇒赤、薄緑になって欲しいのに、なってくれる時となってくれない時がある
⇒条件を変えてないのに違う挙動を示すのは本当に謎です。
 
初心者なので下記のサイトを参考に自分のコードを作成しました。
https://www.agent-grow.com/self20percent/2018/12/21/excel-simulation-cellular-automaton/
 
これより下が私が作ったコードです。
アドバイスいただけると幸いです。
 
'----- 定数 -----
'計算回数
Const LOOP_TIMES As Integer = 1
'休止期状態時色白
Const DEFAULT_COLOR As Integer = 2
'興奮期状態時色赤
Const ACTIVE_COLOR As Integer = 3
'不応期状態時色グレー
Const REFRACTORY_COLOR As Integer = 16
'阻害物色黒
Const BLOCK_COLOR As Integer = 1
'----------------------------------------------------------------
'黄緑を置き場1
Const OKIBA1 As Integer = 4
'置場1からの移動のための色
Const OKIBA11 As Integer = 43
'----------------------------------------------------------------
'開始行数
Const MIN_ROW As Integer = 5
'開始列数
Const MIN_COLUMN As Integer = 5
 
'終了行数数
Const MAX_ROW As Integer = 40
'終了列数
Const MAX_COLUMN As Integer = 40
'ムーア近傍を使用するか(False の場合ノイマン近傍を使用)
Const IS_MOORE = True
'----- 関数 -----
'対象セルの色を取得
Function colorPick(ByVal row As Integer, ByVal column As Integer) As Integer
colorPick = Cells(row, column).Interior.colorIndex
End Function
'対象セルに色を設定
Sub drawCell(ByVal row As Integer, ByVal column As Integer, ByVal color As Integer)
Cells(row, column).Interior.colorIndex = color
End Sub
'現在のセルの色を二次元配列として取得
Function getCullentColorArray() As Integer()
Dim arr(MIN_ROW To MAX_ROW, MIN_COLUMN To MAX_COLUMN) As Integer
For i = MIN_ROW To MAX_ROW
For j = MIN_COLUMN To MAX_COLUMN
arr(i, j) = colorPick(i, j)
Next j
Next i
getCullentColorArray = arr()
End Function
'セルの色を次の時間へ進める
Sub nextTick(ByRef curArr() As Integer)
Dim colorIndex As Integer, nextArr(MIN_ROW To MAX_ROW, MIN_COLUMN To MAX_COLUMN) As Integer
For i = MIN_ROW To MAX_ROW
For j = MIN_COLUMN To MAX_COLUMN
colorIndex = curArr(i, j)
 
' 全体の境界条件
If (MIN_ROW + 7 < i < MAX_ROW - 6) And (MIN_COLUMN + 1) < j < (MAX_COLUMN - 2) Then
 
' 現在のマス赤のとき
If curArr(i, j) = ACTIVE_COLOR Then
 
If curArr(i + 1, j) = OKIBA1 Then
If curArr(i + 6, j) = OKIBA11 Then
nextArr(i, j) = DEFAULT_COLOR
Else: nextArr(i, j) = ACTIVE_COLOR
End If
 
ElseIf curArr(i, j + 1) = REFRACTORY_COLOR Then
nextArr(i, j) = ACTIVE_COLOR
Else: nextArr(i, j) = REFRACTORY_COLOR
 
End If
End If
 
' 現在黒の時は不変
 If curArr(i, j) = BLOCK_COLOR Then
 nextArr(i, j) = BLOCK_COLOR
 End If
  
 ' 現在置場1の時は不変
 If curArr(i, j) = OKIBA1 Then
 nextArr(i, j) = OKIBA1
 End If
 
' 現在グレーの時の3通り
If curArr(i, j) = REFRACTORY_COLOR Then
If curArr(i, j + 1) = ACTIVE_COLOR And curArr(i + 1, j + 1) = OKIBA1 Then
nextArr(i, j) = REFRACTORY_COLOR
ElseIf curArr(i, j + 2) = REFRACTORY_COLOR Then
nextArr(i, j) = REFRACTORY_COLOR
Else: nextArr(i, j) = DEFAULT_COLOR
End If
End If
 
' 現在置場(1)の下の色になってるとき
If curArr(i, j) = OKIBA11 Then
nextArr(i, j) = DEFAULT_COLOR
End If
 
' 現在が白の時
If curArr(i, j) = DEFAULT_COLOR Then
 ' 一旦次も白と仮定する
nextArr(i, j) = DEFAULT_COLOR
' 薄緑関係
If curArr(i - 1, j) = OKIBA1 And curArr(i - 2, j) = ACTIVE_COLOR Then
 If curArr(i + 1, j) = OKIBA11 Or curArr(i + 2, j) = OKIBA11 _
 Or curArr(i + 3, j) = OKIBA11 Or curArr(i + 4, j) = OKIBA11 Then
 nextArr(i, j) = DEFAULT_COLOR
 Else: nextArr(i, j) = OKIBA11
 End If
End If
 
If curArr(i - 1, j) = OKIBA11 Then
If curArr(i - 7, j) = ACTIVE_COLOR Then
nextArr(i, j) = DEFAULT_COLOR
Else: nextArr(i, j) = OKIBA11
End If
End If
 
' 赤関係
If curArr(i, j - 1) = ACTIVE_COLOR Then
If curArr(i + 1, j - 1) = OKIBA1 Then
nextArr(i, j) = DEFAULT_COLOR
Else: nextArr(i, j) = ACTIVE_COLOR
End If
End If
  
  
' 下の文で現在白終わり
End If
 
' 計算のための領域外を白に
 Else: nextArr(i, j) = DEFAULT_COLOR
 End If
 
 
Next j
Next i
'計算した次の時間の状態をもとに色を塗る
For i = MIN_ROW To MAX_ROW
For j = MIN_COLUMN To MAX_COLUMN
Call drawCell(i, j, nextArr(i, j))
Next j
Next i
End Sub
'メイン関数
Sub main()
'開始時の設定
Application.Calculation = xlCalculationManual
'実際にセルを更新する作業
For i = 1 To LOOP_TIMES
DoEvents 'ハングアップしないように操作を受け付ける
Application.ScreenUpdating = False '一度に色を更新させるために一旦画面更新を停止
Application.StatusBar = "シミュレーション中…" & i & "/" & LOOP_TIMES
 
 
Dim l As Integer, curArr() As Integer
curArr() = getCullentColorArray()
Call nextTick(curArr())
Application.ScreenUpdating = True '色を更新させるために画面更新を実施
Next i
'設定復帰処理
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
End Sub
 
 
 
 
 
 
 
 
 

回答
投稿日時: 19/09/20 13:43:34
投稿者: simple

デバッグの丸投げですか。
(以下、何文字か消去)
 
まず、お願いがあります。
・インデントをしっかりつけてください。(これはあなたにとって大切な事柄です。)
・プロシージャの冒頭に Option Explicitとして、
  変数はすべて宣言してください。
・ワークシートに初期設定しておくべきことがあれば追記してください。
 
ところで、
If (MIN_ROW + 7 < i < MAX_ROW - 6) And (MIN_COLUMN + 1) < j < (MAX_COLUMN - 2) Then
という書き方がありますが、これはあなたが思ったようには働きませんよ。
つまり、MIN_ROW + 7 < i < MAX_ROW - 6 といった判別式のことです。
イミディエイトウインドウで
i=1
? 2<i<4
としてみて下さい。Trueが返ります。
 
# 余談ながら、こうした数式そのままのコードが通用する言語は、私の経験ではひとつだけありました。
# たいていの言語はこうした形式には対応していないと思います。

回答
投稿日時: 19/09/20 14:57:20
投稿者: sk

引用:
インデックスが有効でないとのエラーが出る
⇒自分なりには境界条件は守ってると思ってます

引用:
'開始行数
Const MIN_ROW As Integer = 5
'開始列数
Const MIN_COLUMN As Integer = 5
 
'終了行数数
Const MAX_ROW As Integer = 40
'終了列数
Const MAX_COLUMN As Integer = 40

引用:
Sub main()

引用:
curArr() = getCullentColorArray()

引用:
Function getCullentColorArray() As Integer()
Dim arr(MIN_ROW To MAX_ROW, MIN_COLUMN To MAX_COLUMN) As Integer

引用:
getCullentColorArray = arr()

引用:
Sub main()

引用:
Call nextTick(curArr())

引用:
Sub nextTick(ByRef curArr() As Integer)

引用:
For i = MIN_ROW To MAX_ROW
For j = MIN_COLUMN To MAX_COLUMN

引用:
' 全体の境界条件
If (MIN_ROW + 7 < i < MAX_ROW - 6) And (MIN_COLUMN + 1) < j < (MAX_COLUMN - 2) Then

引用:
If curArr(i - 1, j) = OKIBA1 And curArr(i - 2, j) = ACTIVE_COLOR Then

境界条件として記述されている If 文における
比較演算式がおかしなことになっているので、
そりゃそうなりますね。
 
VBA では「 最小値 < 変数 < 最大値 」のような構文で
範囲条件を指定することは出来ません。
 
この場合、まず左側の < 演算子による比較演算
(変数の値が最小値より大きいかどうか)を先に行なって
その結果を Boolean 型の値( True は -1、 False は 0 )として返し、
更にその比較結果( -1 または 0 )と最大値を右側の < 演算子に
よって比較した結果が最終的に返されます。
 
つまり、この時の最大値が 0 より大きければ
必ず True と判定されることになります。
 
引用:
Const MIN_ROW As Integer = 5

引用:
Const MAX_ROW As Integer = 40

引用:
For i = MIN_ROW To MAX_ROW

引用:
MIN_ROW + 7 < i < MAX_ROW - 6

この時の i の初期値は 5 なので、
 
--------------------------------------------------
   5 + 7 < 5 < 40 - 6
-> 12 < 5 < 34
-> False < 34
-> 0 < 34
-> True
--------------------------------------------------
 
という結果となり、
 
引用:
Const MIN_COLUMN As Integer = 5

引用:
Const MAX_COLUMN As Integer = 40

引用:
For j = MIN_COLUMN To MAX_COLUMN

引用:
(MIN_COLUMN + 1) < j < (MAX_COLUMN - 2)

またこの時の j の初期値は 5 なので、
 
--------------------------------------------------
   5 + 1 < 5 < 40 - 2
-> 6 < 5 < 38
-> False < 38
-> 0 < 38
-> True
--------------------------------------------------
 
という結果となり、最終的には
 
引用:
If (MIN_ROW + 7 < i < MAX_ROW - 6) And (MIN_COLUMN + 1) < j < (MAX_COLUMN - 2) Then

   True And True
-> True
 
--------------------------------------------------------------------
 
というわけで、最初のループに入った時点で
そのまま True パートの処理に入ることになります。
 
引用:
' 薄緑関係
If curArr(i - 1, j) = OKIBA1 And curArr(i - 2, j) = ACTIVE_COLOR Then

そして 2 次元配列 curArr の第 1 次元のインデックスの最小値が 5 であるのに対し、
その時点での変数 i の値から 1 や 2 を減じた値を使って curArr の要素を
参照しようとしているわけですが、この時の i の 値が 6 以下であれば
件のエラーが発生することになります。

投稿日時: 19/09/21 08:09:00
投稿者: ペイしん

回答ありがとうございます。
お二方の丁寧な説明のおかげでエラーの原因を理解することができました。
VBAの基本的なことができていなかったみたいなので、これから日々勉強していきます。