けーすけ@北海道のブログ一覧

ネットでいろいろ公開されているソースを、参考にしています。

EXCELを起動後、「Alt+F11」でVBE(Visual Basic Editor)が開きます。
「挿入」から「標準モジュール」を選んで、次のソースを貼り付けてください。

その後、EXCELに戻って「マクロ」で表示されているマクロを実行してください。

もしかすると、予定していない箇所で改行されてしまい、うまく動作しないかもしれません。

その時は、自分で編集してみてね。
ъ( ゜ー＾）ニコッ


'----- ここからソース -----
'変数宣言を強制
Option Explicit
'定数
Private Const total As Integer = 3
'変数
Private cnt As Integer 'カウンター
Private pole(1) As Integer '棒
Private bottom_cell(3) As Integer '各棒の円盤の位置

'--- ハノイの塔スタート --------------
Public Sub Hanoi_Start()

'ビジュアルの準備
Call Set_Pole
Call Set_Discuss
Const n As Integer = 4 '円盤の数
cnt = 0 '初期化
Call Hanoi(n, 0, 1)

End Sub

'--- ハノイの塔本体 ------------------
' 引数
' n:円盤の番号
' a:移動元作業棒
' b:移動先作業棒
'-------------------------------------
Private Sub Hanoi(ByRef n As Variant, ByRef a As Variant, ByRef b As Variant)

If n > 0 Then
Call Hanoi(n - 1, a, total - (a + b))
cnt = cnt + 1 'カウントアップ
pole(0) = Asc("a") + a
pole(1) = Asc("a") + b
'円盤の移動をセルに書き出し
Cells(cnt, 1).Value = n & "番の円盤を" & Chr(pole(0)) & "から" & Chr(pole(1)) & "に移動"
'円盤を移動
Call Move_Discuss(n, pole(0), pole(1))
Call Hanoi(n - 1, total - (a + b), b)
End If

End Sub

'--- 作業棒の設定 --------------------
Private Sub Set_Pole()

'幅調整
Range(Cells(1, 4), Cells(41)).ColumnWidth = 1
'棒aの定義
Range(Cells(4, 12), Cells(8, 12)).ColumnWidth = 0.5
Cells(10, 12).Value = "a"
'棒bの定義
Range(Cells(4, 24), Cells(8, 24)).ColumnWidth = 0.5
Cells(10, 24).Value = "b"
'棒cの定義
Range(Cells(4, 36), Cells(8, 36)).ColumnWidth = 0.5
Cells(10, 36).Value = "c"

End Sub

'--- 最初の円盤を配置 ----------------
Private Sub Set_Discuss()

Range(Cells(5, 11), Cells(5, 13)).Interior.ColorIndex = 1 * 3 '1番目の円盤
Range(Cells(6, 10), Cells(6, 14)).Interior.ColorIndex = 2 * 3 '2番目の円盤
Range(Cells(7, 9), Cells(8, 15)).Interior.ColorIndex = 3 * 3 '3番目の円盤
Range(Cells(8, 8), Cells(8, 16)).Interior.ColorIndex = 4 * 3 '4番目の円盤
'最初の各円盤の位置の初期値を代入
bottom_cell(0) = 5
bottom_cell(1) = 6
bottom_cell(2) = 7
bottom_cell(3) = 8

End Sub

'--- 円盤を移動 ----------------------
' 引数
' n:円盤(1-4)
' a:移動元作業棒(97-99)
' b:移動先作業棒(97-99)
'-------------------------------------
Private Sub Move_Discuss(ByVal n As Integer, ByVal a As Integer, ByVal b As Integer)

Dim i As Long
Dim col(1) As Integer
col(0) = 12 * (a - 96)
col(1) = 12 * (b - 96)
'上に移動
For i = 1000000 To 6000000
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), col(0) - n), Cells(bottom_cell(n - 1), col(0) + n)).Interior.ColorIndex = xlNone
bottom_cell(n - 1) = bottom_cell(n - 1) - 1
Range(Cells(bottom_cell(n - 1), col(0) - n), Cells(bottom_cell(n - 1), col(0) + n)).Interior.ColorIndex = n * 3
If bottom_cell(n - 1) = 3 Then Exit For
End If
Next
'横に移動
If col(1) - col(0) > 0 Then
For i = col(0) * 1000000 To col(1) * 1000000
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), i / 1000000 - n + 1), Cells(bottom_cell(n - 1), i / 1000000 + n)).Interior.ColorIndex = n * 3
Cells(bottom_cell(n - 1), i / 1000000 - n).Interior.ColorIndex = xlNone
End If
Next
Else
For i = col(0) * 1000000 To col(1) * 1000000 Step -1
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), i / 1000000 - n), Cells(bottom_cell(n - 1), i / 1000000 + n + 1)).Interior.ColorIndex = n * 3
Cells(bottom_cell(n - 1), i / 1000000 + n + 1).Interior.ColorIndex = xlNone
End If
Next
End If
'下に移動
For i = 1000000 To 6000000
If i Mod 1000000 = 0 Then
Range(Cells(bottom_cell(n - 1), col(1) - n), Cells(bottom_cell(n - 1), col(1) + n)).Interior.ColorIndex = xlNone
bottom_cell(n - 1) = bottom_cell(n - 1) + 1
Range(Cells(bottom_cell(n - 1), col(1) - n), Cells(bottom_cell(n - 1), col(1) + n)).Interior.ColorIndex = n * 3
If Range(Cells(bottom_cell(n - 1) + 1, col(1) - n), Cells(bottom_cell(n - 1) + 1, col(1) + n)).Interior.ColorIndex <> xlNone Or bottom_cell(n - 1) = 8 Then Exit For
End If
Next

End Sub

'/*----- ここまでソース -----*/

「ハノイの塔」って知っています???

１月１６日に、終了時の画像を追加しました。