人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excel(エクセル)の表の中で、決まったルールに従って数字を移動させたいと思います。ルールは、シンプルなものだけです。例えば横に移動を続け、別の数字にぶつかったら下方向に方向転換するといった程度です。何かよい方法はないでしょうか。アドバイスをお願いします。

●質問者: Yhiroro180
●カテゴリ:コンピュータ ゲーム
✍キーワード:Excel アドバイス エクセル シンプル ルール
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● たけじん
●0ポイント

移動する、というのは「移動する途中経過」を見せるのですか?

それとも、移動した結果を示せればいいのでしょうか。

ぶつからなかった場合は、どうなるのでしょう?

◎質問者からの返答

1セルずつ点滅しながら、移動するという意味です。したがってマクロでコピーを記録してマクロボタンを連続して押すという内容が「エクセル コンピュータシミュレーション」に載っていました。

しかし、これでは数字入力済のセルが増えていくだけで、移動という形にはならないので、数字が隣のセルに入力されたら、以前のセルの数字が消えれば、移動を表現できるかなあと思っています。

もしぶつからなかったら、そのままずっと進めるようにしたいと思います。

しかし、ぶつかるような数値をセルにいれたいと思っています。


2 ● Mook
●100ポイント

面白そうなのでサンプルを作ってみました。


下記を新規 EXCEL ファイルの標準モジュールに貼付け、マクロの実行からmain を実行してみてください。

自分の設定した配置で動作したい場合は、moveNumber を実行してください。

Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const STEP_NUM = 100 '--- 移動ステップ数

'--------------------------------------------------
Sub main()
'--------------------------------------------------
'--- デモ用初期設定
 Columns("A:G").ColumnWidth = 4
 Range("A1:G20").Value = ""
 Range("A1:G20").HorizontalAlignment = xlCenter
 Cells(1, 1) = "◎"
 Cells(1, 4) = 1
 Cells(5, 3) = 2
 Cells(4, 6) = 3
 Cells(9, 5) = 4
 Cells(8, 6) = 5
 moveNumber
End Sub

'--------------------------------------------------
Sub moveNumber()
'--------------------------------------------------
' 移動先セルがから出なければ、方向転換(右・下)
' 右も下も移動できなければ終了
'--------------------------------------------------
 Dim x#, y#, dx#, dy#, dt#, i#
 x = 1: y = 1: dx = 1: dy = 0
 
 For i = 1 To STEP_NUM
 If Cells(y + dy, x + dx).Value <> "" Then
 dt = dx: dx = dy: dy = dt
 If Cells(y + dy, x + dx).Value <> "" Then Exit Sub
 End If
 Cells(y + dy, x + dx).Value = Cells(y, x).Value
 Cells(y, x).Value = ""
 x = x + dx: y = y + dy
 Sleep 300
 Next
End Sub

開始位置は A1 セルになっています。

http://excelvba.pc-users.net/fol1/1_1.html

◎質問者からの返答

ありがとうございます。まだ試していませんが、「はてな」回答者の中には職人のような方がいらっしゃるのだなあと驚き、感謝しております。


3 ● airplant
●100ポイント

「別の数字にぶつかったら・・・」の意味が良く分からなかったので、空白以外の文字にぶつかったら方向転換するマクロを作ってみました。


適当な文字(■など)を入れたセルにカーソルを合わせてマクロを動かすと、右方向に進みます。ぶつかったら来た方向に従って方向転換します。

ループしたときは、適当なセルに文字を入れるか、Ctrl+Breakで止めてください。

なお、処理を簡単にするために、2行目2列目以降で動くようにしています。1行目やA列では、何も動作せずに終わります。

動くスピードはsiDtimeを適当に調整してみてください。小さければ速く動きます。


もしかして、私、大きな勘違いをしているかも知れません。

Option Explicit

Sub MoveChr()
 
 Const siDtime As Single = 0.3
 Dim lR As Long
 Dim iC As Integer
 Dim sChr As String
 Dim iDR As Integer, iDC As Integer
 Dim siTimer As Single
 
 iDR = 0: iDC = 1
 With ActiveCell
 iC = .Column
 lR = .Row
 sChr = .Value
 End With
 
 Do While 1 < iC And iC < 255 And 1 < lR And lR < 65535
 siTimer = Timer()
 While Timer() - siTimer < siDtime
 DoEvents
 Wend
 Cells(lR, iC).Value = ""
 lR = lR + iDR: iC = iC + iDC
 If Cells(lR, iC).Value <> "" Then
 lR = lR - iDR: iC = iC - iDC
 If iDR = 0 And iDC = 1 Then
 iDR = 1: iDC = 0
 ElseIf iDR = 1 And iDC = 0 Then
 iDR = 0: iDC = -1
 ElseIf iDR = 0 And iDC = -1 Then
 iDR = -1: iDC = 0
 Else: iDR = 0: iDC = 1
 End If
 End If
 Cells(lR, iC).Value = sChr
 Loop

End Sub
◎質問者からの返答

ありがとうございます。まだ実行しておりませんが、勘違いということはないと思っております。

VBAでもできるものなのだなあと感激しております。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ