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

回答の条件
  • 1人3回まで
  • 登録:2007/12/12 14:43:40
  • 終了:2007/12/16 07:03:40

回答(3件)

id:takejin No.1

たけじん回答回数1482ベストアンサー獲得回数1922007/12/12 18:38:47

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

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

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

id:Yhiroro180

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

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

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

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

2007/12/12 18:47:46
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912007/12/13 00:22:22

ポイント100pt

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


下記を新規 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

id:Yhiroro180

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

2007/12/13 05:00:40
id:airplant No.3

airplant回答回数220ベストアンサー獲得回数492007/12/13 01:29:03

ポイント100pt

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


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

ループしたときは、適当なセルに文字を入れるか、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
id:Yhiroro180

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

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

2007/12/13 05:05:19

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません