塗る部分と塗らない部分を条件によってわけたいのですが・・・

質問

今回困っているのは下のマクロで
(1)紺なら足跡を残し、青なら進んでいるセルだけ青にして前回の青の足跡は残さないで
(2)セルが紺の足跡でいっぱいになるまで、これを続けます。
この条件をここに追加しようと思ったのですが、なかなかうまく行きません。ヒントだけでも、何か名案がありましたらご回答お願いします。
Const IMAX As Long = 30 '最大 i 座標
Const JMAX As Long = 20 '最大 j 座標
Const NMAX As Long = 50 '最大ステップ数
Const motigomi As Long = 5 'ゴミ「○歩につき●個捨てる」数
Dim ip(MMAX) As Long '人の i 座標
Dim jp(MMAX) As Long '人の j 座標
Dim occ(IMAX, JMAX) As Long
Dim pre(IMAX, JMAX) As Integer
Dim post(IMAX, JMAX) As Integer
Sub ashiato()

Randomize
Cells.Clear

For n = 1 To NMAX 'ステップを進める
For m = 1 To 1
　 iprev = ip(m) '元いた位置
jprev = jp(m)
'移動先 (i, j) を決める
i = i - 1
'周期境界条件
If i > IMAX Then i = i - IMAX
If i < 1 Then i = i + IMAX
If j > JMAX Then j = j - JMAX
If j < 1 Then j = j + JMAX

'実際に移動
ip(m) = i
jp(m) = j

'色付けを更新

pre(i, j) = Int(motigomi * Rnd())
If pre(i, j) = 1 Then
Cells(i, j).Interior.color = RGB(10, 50, 100)

Else
Cells(iprev, jprev).Clear
Cells(i, j).Interior.color = RGB(40, 50, 400)
End If
Next
Next
End Sub

回答No.4

KenKen_SP · ベストアンサー

おはようございます。KenKen_SP です。

専門家の yastak2006 さんがご回答されているのに、こんな拙いものを
出しても良いのだろうか？？？ ...と思いながら。

　　# 設計の流れとかよく知らないので #3 ご回答とか勉強になり
　　# ました^^

実は興味本位で書いてみたコードなので、オリジナルソースも全然使って
ませんし、拙いロジックなので実用途には使えそうもないと思いますが、
それなりに動きますので多少は参考になるかと思います。

シート Map を用意して実行して下さい。では。

Option Explicit

' Win32Api
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

' Human 構造体（キャラクラパラメータ定義）
Private Type Human
　　PosX　　　　　 As Long　　　 ' 位置 Column
　　PosY　　　　　 As Long　　　 ' 位置 Row
　　Value　　　　　As Variant　　' 値--＞表示文字列
　　Direction　　　As Long　　　 ' 移動方向
　　BackupColorIdx As Long　　　 ' 移動先セル背景色退避
　　BackupValue　　As Variant　　' 移動先セル値退避
End Type

Private mWst　　　 As Worksheet　' マップのシート
Private mMap　　　 As Range　　　' 移動可能なマップ範囲Range
Private mGomiCnt　 As Range　　　' ゴミカウンター表示Range
Private mlngGomi　 As Long　　　 ' ゴミ捨て回数カウンター
Private Man()　　　As Human　　　' 人間

' ワークシート設定
Private Const MAP_CEL_W = 4　　　' セルの幅
Private Const MAP_CEL_H = 20　　 ' セルの高さ
Private Const BG_CLRIDX = 1　　　' 背景色カラーインデックス
' マップ設定
Private Const MAPPOS = "$C$3"　　' マップの基点セル
Private Const MAPSIZE_X = 30　　 ' マップ幅セル数
Private Const MAPSIZE_Y = 20　　 ' マップ高セル数
' アイテム設定
Private Const MAN_COUNT = 20　　 ' 配置人間数
Private Const MAN_CLRIDX = 5　　 ' 人間カラーインデックス
Private Const MAN_CAPTION = "人" ' 人間キャプション
Private Const MAN_ATOIDX = 25　　' 足跡カラーインデックス
Private Const GMI_CLRIDX = 39　　' ゴミカラーインデックス
Private Const GMI_CAPTION = "ゴ" ' ゴミキャプション
Private Const GOMIPOI_RATE = 50　' ゴミを捨てる確率分母

Sub Main()

　　Dim i　　　As Long
　　Dim intRes As Integer

　　On Error GoTo ERROR_HANDLER
　　Call Init
　　If MsgBox("中断するには [Ctrl]+[Break] です。", _
　　　　vbOKCancel + vbInformation, "準備完了") = vbOK Then
　　　　With Application
　　　　　　.Cursor = xlWait
　　　　　　.StatusBar = ""
　　　　　　.EnableCancelKey = xlErrorHandler
　　　　End With
　　　　Do
　　　　　　For i = 0 To MAN_COUNT - 1
　　　　　　　　Call MoveHuman(i)
　　　　　　Next
　　　　　　If IsComplete() Then Exit Do
　　　　　　Call Wait(100)　'<-------------------------- ココで速さを調整して下さい
　　　　Loop
　　　　MsgBox "終了条件を満たしました。", vbInformation
　　End If

TERMINATE:
　　With Application
　　　　.Cursor = xlDefault
　　　　.EnableCancelKey = xlInterrupt
　　　　.StatusBar = False
　　End With
　　Exit Sub
ERROR_HANDLER:
　　If Err.Number = 18 Then
　　　　intRes = MsgBox("中断キーが押されました。中止しますか?", _
　　　　　　　　 vbOKCancel + vbExclamation)
　　　　If intRes = vbCancel Then
　　　　　　Err.Clear
　　　　　　Resume
　　　　Else
　　　　　　Resume TERMINATE
　　　　End If
　　Else
　　　　MsgBox Err.Description, vbCritical
　　　　Resume TERMINATE
　　End If
End Sub

' 初期化
Private Sub Init()
　　Set mWst = Nothing
　　Set mMap = Nothing
　　mlngGomi = 0
　　ReDim Man(MAN_COUNT - 1)

　　' シート環境
　　Set mWst = ThisWorkbook.Worksheets("Map")
　　mWst.Activate
　　ActiveWindow.Zoom = 80　 ' 表示倍率80%
　　Application.ScreenUpdating = False
　　With mWst.Cells
　　　　.Clear
　　　　.HorizontalAlignment = xlCenter
　　　　.Font.ColorIndex = 2 ' 2: White
　　　　.Font.Size = 9
　　　　.Interior.ColorIndex = BG_CLRIDX
　　　　.ColumnWidth = MAP_CEL_W
　　　　.RowHeight = MAP_CEL_H
　　End With
　　Call DrawMapField

End Sub

' マップ・人間の初期描写
Private Sub DrawMapField()
　　Dim r1 As Long, r2 As Long
　　Dim c1 As Long, c2 As Long
　　Dim i　As Long
　　Dim lngManPosR As Long
　　Dim lngManPosC As Long

　　' マップ描写
　　With mWst.Range(MAPPOS)
　　　　.Value = "ゴミが捨てられた回数："
　　　　.HorizontalAlignment = xlLeft
　　　　Set mGomiCnt = .Offset(0, 7)
　　　　With mGomiCnt
　　　　　　.Value = 0
　　　　　　.HorizontalAlignment = xlRight
　　　　End With
　　　　With .Offset(0, 8)
　　　　　　.FormulaR1C1 = "=IF(RC[-1]>0,REPT(""|"",RC[-1]),"""")"
　　　　　　.Font.Name = "ＭＳ Ｐゴシック"
　　　　End With
　　End With
　　Set mMap = mWst.Range(MAPPOS).Offset(2).Resize(MAPSIZE_Y, MAPSIZE_X)
　　With mMap
　　　　.Interior.ColorIndex = xlAutomatic
　　　　.Borders.Weight = xlThin
　　End With
　　' 人間描写
　　With mMap
　　　　' マップの座標
　　　　r1 = .Row:　　r2 = .Row + .Rows.Count - 1
　　　　c1 = .Column: c2 = .Column + .Columns.Count - 1
　　End With
　　i = 0 ' 人間配置カウンタ
　　While i < MAN_COUNT
　　　　Randomize
　　　　lngManPosR = Int((r2 - r1 + 1) * Rnd + r1)
　　　　lngManPosC = Int((c2 - c1 + 1) * Rnd + c1)
　　　　With mWst.Cells(lngManPosR, lngManPosC)
　　　　　　If .Value = "" Then
　　　　　　　　' パラメータ設定
　　　　　　　　Man(i).PosX = .Column
　　　　　　　　Man(i).PosY = .Row
　　　　　　　　Man(i).Value = MAN_CAPTION
　　　　　　　　Man(i).Direction = Int(4 * Rnd + 1)
　　　　　　　　Man(i).BackupColorIdx = .Interior.ColorIndex
　　　　　　　　Man(i).BackupValue = .Value
　　　　　　　　' 描写
　　　　　　　　.Interior.ColorIndex = MAN_CLRIDX
　　　　　　　　.Value = Man(i).Value
　　　　　　End If
　　　　　　i = i + 1
　　　　End With
　　Wend
　　Application.ScreenUpdating = True
End Sub

' 人間の移動
Private Sub MoveHuman(ByVal i As Long)
　　Dim rngNext As Range
　　Dim rngPrev As Range
　　Dim x　　　 As Long, y As Long

　　' 移動方向と移動量計算
　　Select Case Man(i).Direction
　　　　Case 1: x = 1　' Right
　　　　Case 2: y = 1　' Down
　　　　Case 3: x = -1 ' Left
　　　　Case 4: y = -1 ' Up
　　End Select
　　' 移動元・移動先セル取得
　　On Error Resume Next
　　Set rngPrev = mWst.Cells(Man(i).PosY, Man(i).PosX)
　　Set rngNext = mWst.Cells(Man(i).PosY, Man(i).PosX).Offset(y, x)
　　If Err Then　 ' エラー時は移動しない
　　　　Err.Clear
　　　　Set rngPrev = Nothing
　　　　Set rngNext = Nothing
　　　　Exit Sub
　　End If
　　On Error GoTo 0
　　' 当たり判定
　　If Not Intersect(mMap, rngNext) Is Nothing _
　　　 And rngNext.Value <> MAN_CAPTION Then
　　　　Randomize
　　　　With rngPrev
　　　　　　If Int(GOMIPOI_RATE * 100 * Rnd + 1) < 100 Then
　　　　　　　　' ゴミ捨て処理
　　　　　　　　.Interior.ColorIndex = GMI_CLRIDX
　　　　　　　　.Value = GMI_CAPTION
　　　　　　　　mlngGomi = mlngGomi + 1
　　　　　　　　mGomiCnt.Value = mlngGomi
　　　　　　Else
　　　　　　　　' 移動元の復元
　　　　　　　　.Value = Man(i).BackupValue
　　　　　　　　If .Value <> GMI_CAPTION Then
　　　　　　　　　　.Interior.ColorIndex = MAN_ATOIDX
　　　　　　　　Else
　　　　　　　　　　.Interior.ColorIndex = GMI_CLRIDX
　　　　　　　　End If
　　　　　　End If
　　　　End With
　　　　' 人間の再描写
　　　　With rngNext
　　　　　　' 移動先の情報を退避
　　　　　　Man(i).BackupColorIdx = .Interior.ColorIndex
　　　　　　Man(i).BackupValue = .Value
　　　　　　' 人間の移動描写
　　　　　　.Interior.ColorIndex = MAN_CLRIDX
　　　　　　.Value = Man(i).Value
　　　　　　Man(i).PosX = .Column
　　　　　　Man(i).PosY = .Row
　　　　End With
　　　　' 次の移動方向を決める約1/3の確率で方向変換
　　　　Randomize
　　　　If Int(300 * Rnd + 1) < 100 Then
　　　　　　Man(i).Direction = Int(4 * Rnd + 1)
　　　　End If
　　Else
　　　　' 障害物に当たったので方向転換（同一方向がでても無視）
　　　　Man(i).Direction = Int(4 * Rnd + 1)
　　End If
　　Set rngPrev = Nothing
　　Set rngNext = Nothing
　　DoEvents
End Sub

' 終了判定関数
Private Function IsComplete() As Boolean
　　Dim C As Range
　　IsComplete = True
　　For Each C In mMap
　　　　If C.Interior.ColorIndex = xlAutomatic Then
　　　　　　IsComplete = False
　　　　　　Exit For
　　　　End If
　　Next
End Function

' ウェイト処理
Private Sub Wait(ByVal Miliseconds As Long)
　　Dim t As Long
　　If Miliseconds > 0 Then
　　　　t = timeGetTime() + Miliseconds
　　　　While t > timeGetTime()
　　　　　　DoEvents
　　　　Wend
　　End If
End Sub

お礼

Σ(￣口￣;)はっ　これはなんなんですか・・・。
プログラムを動かしたとき、感動して鳥肌が立ちました。
VBで鳥肌が立ったのは初めてです。
”l”をゴミ数を表すバロメーターにしてしまっているところとか、すごい！！と思った。常人のアイデアではないですねぇ

ただ、もう少しこのプログラムを読むのに時間が必要と思いますので、質問がでてきたら、送ります★ほんとうに、本当にありがとうございましたo(*≧∇≦)ノ"

回答No.5

yastak2006

#3の回答の訂正を掲載します
用件定義×　正しくは　要件定義です
「Numeric = "abcde" '実行結果となる値を予想し入力する」の
Numericの値には"1234567890"が入ります。
失礼しました。

回答No.3

yastak2006

質問には直接関係が無いのですが、これから先に必要になると思うので
プログラムの作成手順を簡単に説明しておきます。
１．用件定義（仕様を定義する）
今回の場合は
・画面30X20において人を左から右へ移動させる
・壁に差し掛かったら、？？？？
・5分の1の確率でごみを捨てる
＊境界線判定が良く分からないのでコメントできませんでした。
２．画面設計
画面の要素をイメージ画像としてまとめる。
３．プログラム設計
処理の流れをフロー図でまとめる。
＊用件定義に使った文章を線で繋ぐと早くできる
４．変数表、関数表を作成する
クラスを定義する場合は引数や戻り値などをまとめておく
使う変数のスコープ順に並べてまとめておく
変数や関数の命名規約は頭にプレフィックスをつける
例、グローバル変数　G_XXXXXX　プライベート変数　M_XXXXXX
　　ラベル　lblXXX 　テキストボックスtxtXXXX　
　　意味を持たない命名はしないこと。
５．フローを元にコメントを作成
フロー図を元にコメントをコーディングしていく。
現段階では、難しい処理のところはコメントのままにする。
例えば、
private const strSample="1234567890abcde"
Dim Numeric as String
For count=1 to Len(strSample)
'文字列の中のcount番目（以下count）の文字を取得する
'文字が数値であれば変数Numericに退避する
　　Numeric = "abcde" '実行結果となる値を予想し入力する
　Next

取り合えず難しい処理は後回しにして、処理の流れ図通りに組んでみる勿論、途中でエラーが発生しないように必要な値は直に入力してやる　

こんな感じでプロジェクトは進んでいます。難しいところに時間をかけず、分かるところから順に進んでいけば良いと思います。
それにはまず、しっかりと理解することです。

お礼

お礼が遅くなってすみません・・・
理解が遅くて、せっかくのアドバイスなのに、ちゃんと読み込めていないのにお礼をするのは失礼になるのかと思い。

≫質問には直接関係が無いのですが、これから先に必要になると思うのでプログラムの作成手順を簡単に説明しておきます。

わあ、素晴らしいアドバイス！
ほとんど独学なので、こういう貴重な意見は大事にしています！
ありがとうございます、kenkenさん(^_^)

回答No.2

yastak2006

可読性に欠けるプログラムですね。
もっと細かく分ける癖をつけましょう。
問題の足跡を消す処理は
If pre(i, j) = 1 Then
　　　Cells(i, j).Interior.color = RGB(10, 50, 100)
Else
　　　Cells(iprev, jprev).Clear
　　　Cells(i, j).Interior.color = RGB(40, 50, 400)
End If
にあります。
サイコロの目が1以外はすべてクリアーして青にしています。
条件にその場所の色を入れるか、該当座標のサイコロの値を入れない　とだめですね。

・For文の1TO1は遅くなりますのでつけない方が良いでしょう。どうせ　やるなら　１　TO　定数にしましょう。
・J座標の変数が更新されていません。同じ位置で良いのですか？
・全体的に言えることは不要な配列変数を使いすぎです。
　メモリーが足りなくなります。
・見やすいようにインデントを付けると良いでしょう。
以上です。

お礼

ご親切なアドバイス、本当に、どうもありがとうございます。
返事が遅くなって申し訳ありません・・・。

≫For文の1TO1は遅くなりますのでつけない方が良いでしょう。どうせ　やるなら　１　TO　定数にしましょう。
もとのプログラムは定数を使っていました。教えてgoo!で文字数に制限があったため、定数のコードを省きました。

≫・J座標の変数が更新されていません。同じ位置で良いのですか？
あ！！「i = i - 1’移動先を決める」の所ですよね。もとのプログラムには「j=j+1とj=j-1」（右か左にランダムに動く）があったのですが、上と同じ理由で省きました。

≫・全体的に言えることは不要な配列変数を使いすぎです。
　メモリーが足りなくなります。
ですよね・・・改善します！！(><")

≫・見やすいようにインデントを付けると良いでしょう。
そうですね！！

ほんとうに大切なお時間を割いていただいてのアドバイスのおかげで、勉強させていただきました。
ありがとうございます。

回答No.1

yastak2006

プログラムの仕様が良く分かりません。補足説明ねがいます。

まずは何をしたいのかを箇条書きにしてみると良いですよ。
その仕様を満たす処理図を描いてみてプログラムの流れを大まかに掴むと、その後のコーディングが楽になります。

補足

そっか、箇条書きか！アドバイスありがとうございます！(^▽^)♪♪
そうですよね、まだ自分の中で混乱しています。

イメージとしては、
・青：人間　紺：置き去られたゴミ　です。
・motigomiのサイコロをふって、確率1/5でゴミを捨てます。
・ゴミを捨てなければ、青（人間）はclear,紺（ゴミ）はそのままで次のステップです。
しかし、この上のマクロではすでに捨ててあるゴミの上を通った人間がゴミ（紺のセル）を消してしまっています。これがバグなんです。

この補足説明でわかっていただけたでしょうか？・・・(>_<)！