を実現するプログラム例
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
cn = 0
n = Cells(4, 2)
Call zy
Call f(0) 'n次魔方陣作成プロシージャ
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 = 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)
If cn = 1 Then Exit Sub
Else
Call h
If cn = 1 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
tobi:
End Sub
Private Sub CommandButton2_Click()
Rows("5:20000").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
