Re5：50歳から始めるラズベリーパイ-10
Re5：50歳から始めるラズベリーパイ
簡単なゲームで学ぶVBAプログラミング入門
amazon kindle版を出版しました。
3.4 ハノイの塔の作成-3
プログラム例です。
Option VBAsupport 1
Dim kosu As Integer '円盤の個数
Dim ps(3, 10) As Integer '位置psn("A,B,C" ,"下から順にならぶ")
Dim psn(3) As Integer '位置psn("A,B,C")の個数
Dim kn As Integer '押した数
Dim kx1 As Integer 'クリックした列
Dim kx2 As Integer 'クリックした列
Range("A1: BM15 ").Clear 'A1からBM15の範囲をクリア"
Range("A:BM").ColumnWidth = 1 '列の幅を変更します
'円盤の個数10までできます。
kosu = 3
'初期配置
For i = 0 To 9
For ii = 0 To 2
ps(ii, i) = 0
psn(ii)=0
Next ii
Next i
psn(0) = kosu 'Aに3個
For i = 0 To kosu - 1
ps(0, i) = kosu - i
Next i
Call hyoji
End Sub
'******************************
Sub hyoji()
'Cells(4, 67) = psn(0)
'Cells(4, 68) = psn(1)
'Cells(4, 69) = psn(2)
For i = 0 To 9
' Cells(i + 5, 67) = ps(0, i)
' Cells(i + 5, 68) = ps(1, i)
' Cells(i + 5, 69) = ps(2, i)
Next i
Range("A1: BM15 ").Clear 'A1からBM15の範囲をクリア"
'棒を描きます。
For i = 1 To 10
Cells(i + 1, 11).Interior.Color = RGB(0, 0, 0)
Cells(i + 1, 33).Interior.Color = RGB(0, 0, 0)
Cells(i + 1, 55).Interior.Color = RGB(0, 0, 0)
Cells(i + 1, 22).Interior.Color = RGB(200, 200, 100)
Cells(i + 1, 44).Interior.Color = RGB(200, 200, 100)
Next i
'右端に円盤を描く
For i = 0 To 2
For ii = 0 To psn(i) - 1
For iii = 0 To ps(i, ii) - 1
x1 = iii + 12 + i * 22
y1 = 11 - ii
x2 = 10 - iii + i * 22
Cells(y1, x1).Interior.Color = RGB(255, 0, 0)
Cells(y1, x2).Interior.Color = RGB(255, 0, 0)
Next iii
Next ii
Next i
End Sub
'************************************************
'ワークシートをクリックなどの際に動作するルーチンです。
Sub hanoi()
Dim x As Integer 'クリックした列
Call hyoji2
x = ActiveCell.Column
If (x = 11 Or x = 33 Or x = 55) Then
If (kn Mod 2 = 0) Then
Range("A1: BM1 ").Clear
Cells(1, x).Value = "○"
kx1 = x
Else
Cells(1, x).Value = "▼"
kx2 = x
End If
kn = kn + 1
If (kn >= 2) Then
Call ido
kn = 0
End If
'Cells(1, 70).Value = kn
End If
'Cells(1, 70).Value = kn
'Cells(2, 70).Value = kx1
'Cells(3, 70).Value = kx2
Call hyoji2
Call chk
End Sub
'************************************************
'完了チェック
Sub chk()
Dim n1 As Integer
n1 = 0
For i = 0 To kosu - 1
If (ps(2, i) = kosu - i) Then
n1 = n1 + 1
End If
Next i
'もしCの棒の個数が順にならんでいたら
If n1 = kosu Then
Cells(1, 11).Value = ("完成！！")
End If
End Sub
'************************************************
'移動します。
Sub ido()
Dim n1 As Integer
Dim n2 As Integer
Dim ok As Integer '0だと移動可
Dim r1 As Integer '移動元一番上の大きさ
Dim r2 As Integer '移動先一番上の大きさ
n1 = (kx1 - 11) / 22
n2 = (kx2 - 11) / 22
'Cells(2, 69).Value = n1
'Cells(3, 69).Value = n2
ok = 0
If (kx1 <> kx2) Then
'移動元○の一番上
If (psn(n1) = 0) Then '移動元になにもない
ok = ok + 1
Else
r1 = ps(n1, psn(n1) - 1)
End If
'移動先▼の一番上
If (psn(n2) = 0) Then
r2 = 0
Else
r2 = ps(n2, psn(n2) - 1)
End If
If *1
ps(n1, psn(n1)) = 0
End If
End If
'Cells(1, 67) = ok
End Sub
'************************************************
Sub hyoji2()
Range("A2: BM15 ").Clear 'A1からBM15の範囲をクリア"
'Cells(4, 67) = psn(0)
'Cells(4, 68) = psn(1)
'Cells(4, 69) = psn(2)
For i = 0 To 9
'Cells(i + 5, 67) = ps(0, i)
'Cells(i + 5, 68) = ps(1, i)
'Cells(i + 5, 69) = ps(2, i)
Next i
'棒を描きます。
For i = 1 To 10
Cells(i + 1, 11).Interior.Color = RGB(0, 0, 0)
Cells(i + 1, 33).Interior.Color = RGB(0, 0, 0)
Cells(i + 1, 55).Interior.Color = RGB(0, 0, 0)
Cells(i + 1, 22).Interior.Color = RGB(200, 200, 100)
Cells(i + 1, 44).Interior.Color = RGB(200, 200, 100)
Next i
'右端に円盤を描く
For i = 0 To 2
For ii = 0 To psn(i) - 1
For iii = 0 To ps(i, ii) - 1
x1 = iii + 12 + i * 22
y1 = 11 - ii
x2 = 10 - iii + i * 22
Cells(y1, x1).Interior.Color = RGB(255, 0, 0)
Cells(y1, x2).Interior.Color = RGB(255, 0, 0)
Next iii
Next ii
Next i
End Sub
