第１話 対角線法に入る前の小改良
を実現するプログラム再掲
Dim a(20) As Integer, n As Integer, cn As Long
Private Sub CommandButton1_Click()
CommandButton2_Click
cn = 0
n = Cells(4, 2)
Call f(0) 'n次魔方陣作成プロシージャ
End Sub
Sub f(g As Integer)
Dim i As Integer, j As Integer
For i = 1 To n * n
If g > 0 Then
For j = 0 To g - 1
If i = a(j) Then GoTo tobi
Next
End If
a(g) = i
If g + 1 < n * n Then
Call f(g + 1)
Else
Call h
End If
tobi:
Next
End Sub
Sub h()
Dim i As Integer, j As Integer, s As Integer, am As Integer, w As Integer
For i = 0 To n - 1
w = 0
For j = 0 To n - 1
w = w + a(n * i + j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
Next
For i = 0 To n - 1
w = 0
For j = 0 To n - 1
w = w + a(n * j + i)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
Next
w = 0
For i = 0 To n - 1
w = w + a(n * i + i)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
w = 0
For i = 0 To n - 1
w = w + a(n * i + n - 1 - i)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
For i = 0 To 8
s = Int(i / n)
am = i Mod n
Cells(6 + s + 4 * Int(cn / 5), 2 + am + 4 * (cn Mod 5)) = a(i)
Next
cn = cn + 1
tobi:
End Sub
Private Sub CommandButton2_Click()
Rows("5:20000").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
第９講第10話でも、
魔方陣の条件検査を表示関数h()で行っていますが、
本来は、魔方陣生成プロシージャのfで検査を行うべきです、
と申し上げました。
皆さん、検査をh()ではなく、Sub f(g As Integer)の方で行うように、
改良して下さい。
尚、今回の改良では５次魔方陣が限界ですから、
Integer型はすべてByte型に変更しましょう。
型を変更するだけで、２倍ぐらい高速化します。
また、
Dim a(20) As Integer
は
Dim a(10,10) As Integer
２次元配列に変更しましょう。
ヒントとして
Sub f(g As Byte)
Dim i As Byte, j As Byte, y As Byte, x As Byte, jy As Byte, jx As Byte, w As Byte
y = Int(g / n)
x = g Mod n
For i = 1 To n * n
If g > 0 Then
For j = 0 To g - 1
jy = Int(j / n)
jx = j Mod n
If i = a(jy, jx) Then GoTo tobi
Next
End If
a(y, x) = i
までを示しておきます。
y = Int(g / n)
x = g Mod n
が、２次元配列a(y, x) = iに対応するための工夫です。
同様に
jy = Int(j / n)
jx = j Mod n
If i = a(jy, jx) Then GoTo tobi
も、２次元配列に対応するためです。
解答例は、30行下に示します。
解答例
Dim a(10, 10) As Byte, n As Byte, cn As Long
Private Sub CommandButton1_Click()
CommandButton2_Click
cn = 0
n = Cells(4, 2)
Call f(0) 'n次魔方陣作成プロシージャ
End Sub
Sub f(g As Byte)
Dim i As Byte, j As Byte, y As Byte, x As Byte, jy As Byte, jx As Byte, w As Byte
y = Int(g / n)
x = g Mod n
For i = 1 To n * n
If g > 0 Then
For j = 0 To g - 1
jy = Int(j / n)
jx = j Mod n
If i = a(jy, jx) Then GoTo tobi
Next
End If
a(y, x) = i
If x = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + a(y, j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If y = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + a(j, x)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If x = 0 And y = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + a(j, n - 1 - j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If x = n - 1 And y = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + a(j, j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If g + 1 < n * n Then
Call f(g + 1)
Else
Call h
End If
tobi:
Next
End Sub
Sub h()
Dim i As Byte, j As Byte, s As Byte, am As Byte, w As Byte
For i = 0 To n * n - 1
s = Int(i / n)
am = i Mod n
Cells(6 + s + (n + 1) * Int(cn / 5), 2 + am + (n + 1) * (cn Mod 5)) = a(s, am)
Next
cn = cn + 1
tobi:
End Sub
Private Sub CommandButton2_Click()
Rows("5:20000").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
シートの方もセンタリングをして、列幅も変更しました。
参考ダウンロード添付ファイル
を対角線法で改良していきます。
ここから読んでいる方は、是非添付ファイルを開いてそれをお使い下さい。
