| |
▼文哉 さん：
先ほどの条件間違えていました。
If r + dr >= 1 And r + dr <= .Rows.Count And _
c + dc >= 1 And c + dc <= .Columns.Count Then
となります。
始めたら面白かったので軌跡表現も作成してみました。
重複箇所の判定が思いつかなかったので範囲全体を配列に
取っており不恰好です。軌跡全部の再描画は避けました。
これも参考になればとおもいます。
あと前回移動方向による重み付けもして見ました。
Sub randomwalk_2()
Dim r As Long, dr As Integer, tr As Long, mr As Long
Dim c As Long, dc As Integer, tc As Long, mc As Long
Dim n As Integer, LM As Integer
Dim i As Long, j As Long, k As Long
Dim nt As Integer
Dim AD As Variant
Dim WS As Variant
Randomize
k = 30 '長さ
mr = 100 '行範囲
mc = 100 '列範囲
nt = 300 '繰り返し回数
ReDim AD(1 To k)
With ActiveSheet
With .Cells
.Interior.ColorIndex = xlNone
.ClearContents
End With
WS = .Range(.Cells(1, 1), .Cells(mr, mc)).Value
r = 30
c = 30
With .Cells(r, c)
.Interior.ColorIndex = 1
AD(1) = .Address
WS(r, c) = WS(r, c) + 1
LM = 9
End With
For i = 1 To nt
'乱数発生させる
n = rndMove(LM)
LM = n
'n = Int(Rnd * 9) + 1
'乱数から動き量を導く
Select Case n
Case 1: dr = -1: dc = 1
Case 2: dr = 0: dc = 1
Case 3: dr = 1: dc = 1
Case 4: dr = 1: dc = 0
Case 5: dr = 1: dc = -1
Case 6: dr = 0: dc = -1
Case 7: dr = -1: dc = -1
Case 8: dr = -1: dc = 0
Case 9: dr = 0: dc = 0
End Select
'移動可能か判断
If r + dr >= 1 And r + dr <= mr And _
c + dc >= 1 And c + dc <= mc Then
c = c + dc
r = r + dr
End If
'移動(消去）
If AD(k) <> "" Then
tr = .Range(AD(k)).Row
tc = .Range(AD(k)).Column
WS(tr, tc) = WS(tr, tc) - 1
If WS(tr, tc) = 0 Then
.Cells(tr, tc).Interior.ColorIndex = xlNone
End If
End If
'データ入替
For j = k To 2 Step -1
AD(j) = AD(j - 1)
Next j
'移動
If nt - i + 1 >= k Then
With .Cells(r, c)
WS(r, c) = WS(r, c) + 1
AD(1) = .Address
.Interior.ColorIndex = 1
End With
End If
'時間調整0.1秒
Application.Wait [ Now() + "00:00:00.02"]
Next i
End With
End Sub
Function rndMove(ByVal LM As Integer)
Dim tmp
Dim MoveData(1 To 9) As Variant
Randomize
MoveData(1) = "112237889"
MoveData(2) = "112233489"
MoveData(3) = "122334459"
MoveData(4) = "233445569"
MoveData(5) = "344556679"
MoveData(6) = "455667789"
MoveData(7) = "146677889"
MoveData(8) = "112677889"
MoveData(9) = "123456789"
tmp = Int(Rnd * 9) + 1
rndMove = Val(Mid(MoveData(LM), tmp, 1))
End Function
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
