Excel (VBA)

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

 
(指定なし : 指定なし)
セルオートマトン、フロアフィールド
投稿日時: 19/01/06 12:46:09
投稿者: dndn

以前、別のサイトにて赤マスがずっと湧き出るポイントがあり、そこからゴールのセルまでランダムに赤マスが移動するようなプログラム(下参照)を教えていただきました。障害物として通らないセルも設定してあります。
下のコードを実行するとシートの左上(A1セル)から右下(AD30セル)までセルがランダムに動きます。
右及び下へ行く割合が高くなっている。等教えていただきましたが、どのような仕組みになっているのかがあまりよくわかりません。
「ここの部分が〇〇を示すコード」という風に教えていただけませんでしょうか。
 
また、下のコードを活用して、湧き出るポイントを一カ所ではなく、複数箇所に、そしてゴールの場所も複数の場所に設定することはできないでしょうか。
複雑な質問ですみません。よろしくお願いします。
 
以下VBAコード
 
Option Explicit
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Public Sub Samp1()
   Dim rngs() As Range, rng As Range, rngX As Range
   Dim sAdr As String
   Dim i As Long, j As Long, k As Long
   Const CLPC As Long = 500
 
   Randomize
 
   k = 1
   ReDim rngs(1 To k)
   With Range("A1").Resize(30, 30)
      .EntireColumn.ColumnWidth = 2
      Set rngs(k) = .Cells(1)
      Set rngX = Union(.Cells(10, 8).Resize(2, 2) _
            , .Cells(14, 23).Resize(2, 2) _
            , .Cells(20, 23).Resize(2, 2) _
            , .Cells(20, 15).Resize(2, 2)) '????????Q????E??Z???????
 
      For i = 1 To CLPC
         For j = 1 To k
            Set rngs(j) = fncSamp1(.Cells, rngs(j), rngX)
         Next
         If ((i Mod 5) = 0) Then
            k = k + 1
            ReDim Preserve rngs(1 To k)
            Set rngs(k) = .Cells(1)
         End If
         Set rng = rngs(1)
         For j = 2 To k
            Set rng = Union(rng, rngs(j))
         Next
         .Interior.ColorIndex = xlNone
         rngX.Interior.ColorIndex = 1
         rng.Interior.ColorIndex = 3
         Sleep 100
         DoEvents
         Application.Wait [Now()] + 700 / 86400000
      Next
 
      sAdr = .Cells(.Rows.Count, .Columns.Count).Address
      For i = k To 1 Step -1
         rngs(i).Interior.ColorIndex = xlNone
         If (rngs(i).Address = sAdr) Then Exit For
         Sleep 50
         DoEvents
         Application.Wait [Now()] + 700 / 86400000
      Next
      .Interior.ColorIndex = xlNone
   End With
End Sub
 
Private Function fncSamp1(rng As Range, r As Range, rngX As Range) As Range
   Dim i As Long, j As Long
 
   i = 0: j = 0
   With rng
      If (.Cells(.Rows.Count, .Columns.Count).Address _
         <> r.Address) Then
         Do
            Select Case r.Row
               Case .Cells(1).Row
                  i = 1
                  If (Rnd() < 0.5) Then i = 0
               Case .Cells(.Rows.Count, 1).Row
                  i = -1
                  If (Rnd() < 0.5) Then i = 0
               Case Else
                  i = 1
                  If (Rnd() < 0.25) Then i = -1
                  If (Rnd() < 0.25) Then i = 0
            End Select
            Select Case r.Column
               Case .Cells(1).Column
                  j = 1
                  If (Rnd() < 0.5) Then j = 0
               Case .Cells(.Columns.Count).Column
                  j = -1
                  If (Rnd() < 0.5) Then j = 0
               Case Else
                  j = 1
                  If (Rnd() < 0.25) Then j = -1
                  If (Rnd() < 0.25) Then j = 0
            End Select
         Loop While ((i = 0) And (j = 0))
      End If
   End With
 
   Set fncSamp1 = r.Offset(i, j)
   If (Not Intersect(fncSamp1, rngX) Is Nothing) Then
      Set fncSamp1 = r
   End If
End Function

投稿日時: 19/01/06 12:50:24
投稿者: dndn

コード内17行目
 
Set rngX = Union(.Cells(10, 8).Resize(2, 2) _
            , .Cells(14, 23).Resize(2, 2) _
            , .Cells(20, 23).Resize(2, 2) _
            , .Cells(20, 15).Resize(2, 2)) '????????Q????E??Z???????
 
の'???????以降は無視してください。申し訳ありません。

回答
投稿日時: 19/01/06 13:22:19
投稿者: simple

こんにちは。
 
おもしろいもののようですね。
 
ちょっと野暮なはなしで済みませんが、確認させて下さい。
(1)別のサイトで教えていただいたなら、そこで継続して提示されたかたに質問されるのが
   いちばんよいのでは無いですか?
(2)説明してください、といわれた場合、できるだけあなたにあった説明するのがよいでしょう。
  しかし、あなたがVBAにどの程度お詳しいのかわかりません。
  まったく知らないひとに、文法から説明するのは無理ですし、
  詳しい方なら、はいそれは知っています、ということになりますね。
  こうした場合は、どこまで分析されたかを説明されたうえで、
  不明点を絞って質問されるとよいと思います。そのあたりはいかがですか?
(3)ステップ実行して、動きを観察するというのがよいと思います。
  プログラムがどういう順序で実行されているかもよくわかりますし、何をしているかも
  分かる可能性が高いです。そうしたことは実行されていますか?

投稿日時: 19/01/06 13:55:28
投稿者: dndn

早速のご回答ありがとうございます。
 
⑴諸事情により、それが出来なくなりました。なのでここで質問させていただいています。申し訳ありません。
 
⑵ご指摘ありがとうございます。一応、初心者レベルのものは習得しています。
しかし、ちょうど文字化けしている部分(私のミスでコード内に残っている部分)以降からがごちゃごちゃしていて、理解が追いついていません。
 
⑶動作確認はしており、コード内の数値や命令文がそれぞれどの動きを示しているのかなど、簡単なところは理解しております。(障害物の位置など))
VBAの世界ではまだまだ初心者だと認識しております。
よろしくお願いします。

回答
投稿日時: 19/01/06 14:37:04
投稿者: simple

返信ありがとうございます。
 
こういう場合に有効なのは、ご自分なりの理解でコードにコメントをつけていくことです。
するとご自分の理解が視覚化できます。
不明なところは、ステップ実行(ところどころにブレークポイントをつけてスキップ)すれば
動きは推定できます。
そんな方針で取り組まれたらいかがですか?
 
質問への回答の概略
(1)湧きだし口を複数にするのは簡単です。
   Set rngs(k) = .Cells(1) のところを乱数でコントロールするだけです。
(2)ゴールの位置を変更するのは簡単ではないかもしれません。
   決められた矩形の中だけを動き、矩形の右下がゴールという設定であれば、
   いまのものを拡張すればできるとは思いますが。
    
これから外出しますので、これでいったん区切り(私の)とさせてください。

回答
投稿日時: 19/01/07 22:06:34
投稿者: simple

知恵袋に質問されたようですから、こちらは閉じたほうがよいと思います。(私見)

投稿日時: 19/01/07 23:22:52
投稿者: dndn

ありがとうございました。