第６話 対角線法の完成！
を実現するプログラム例
Dim a(10, 10) As Byte, n As Byte, cn As Long, y(100) As Byte, x(100) As Byte
Private Sub CommandButton1_Click()
CommandButton2_Click
hj = Timer
cn = 0
n = Cells(4, 2)
Call zy
Call f(0) 'n次魔方陣作成プロシージャ
ow = Timer
Cells(4, 16) = "生成にかかった時間は"
Cells(4, 20) = ow - hj
Cells(4, 21) = "秒です。 "
End Sub
Sub zy()
Dim i As Byte, j As Byte, k As Byte
Dim b(10, 10) As Byte
For i = 0 To n - 1
For j = 0 To n - 1
b(i, j) = n * n + 1
Next
Next
For i = 0 To n - 1
b(i, i) = i
Next
k = n
For i = 0 To n - 1
If b(i, n - 1 - i) = n * n + 1 Then
b(i, n - 1 - i) = k
k = k + 1
End If
Next
For i = 0 To n - 1
For j = 0 To n - 1
If b(i, j) = n * n + 1 Then
b(i, j) = k
k = k + 1
End If
Next
Next
For i = 0 To n - 1
For j = 0 To n - 1
y(b(i, j)) = i
x(b(i, j)) = j
Next
Next
End Sub
Sub f(g As Byte)
Dim i As Byte, j As Byte, w As Byte
For i = 1 To n * n
If g > 0 Then
For j = 0 To g - 1
If i = a(y(j), x(j)) Then GoTo tobi
Next
End If
a(y(g), x(g)) = i
If x(g) = n - 2 And y(g) = 0 Then
w = 0
For j = 0 To n - 2
w = w + a(y(g), j)
Next
w = w + a(y(g), n - 1)
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If y(g) = n - 2 And x(g) = 0 Then
w = 0
For j = 0 To n - 2
w = w + a(j, x(g))
Next
w = w + a(n - 1, x(g))
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If x(g) = n - 1 And y(g) > 0 And y(g) < n - 1 Then
w = 0
For j = 0 To n - 1
w = w + a(y(g), j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If y(g) = n - 1 And x(g) > 0 And x(g) < n - 1 Then
w = 0
For j = 0 To n - 1
w = w + a(j, x(g))
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If x(g) = n - 2 And y(g) = n - 1 Then
w = 0
For j = 0 To n - 2
w = w + a(y(g), j)
Next
w = w + a(y(g), n - 1)
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If y(g) = n - 2 And x(g) = n - 1 Then
w = 0
For j = 0 To n - 2
w = w + a(j, x(g))
Next
w = w + a(n - 1, x(g))
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If x(g) = 0 And y(g) = 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(g) = n - 1 And y(g) = 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)
If n = 4 And cn = 100 Then Exit Sub
If n = 5 And cn = 50 Then Exit Sub
Else
Call h
If n = 4 And cn = 100 Then Exit Sub
If n = 5 And cn = 50 Then Exit Sub
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
If cn = 1 Then Cells(4, 8) = "魔方陣が"
Cells(4, 10) = cn
If cn = 1 Then Cells(4, 11) = "個生成されました。 "
End Sub
Private Sub CommandButton2_Click()
Rows("5:20000").Select
Selection.ClearContents
Range("H4:U4").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
