を実現するプログラム例
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 Mod n = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + a(n * Int(g / n) + j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If Int(g / n) = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + a(n * j + (g Mod n))
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If g = n * n - 1 Then
w = 0
For j = 0 To n - 1
w = w + a(n * j + j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If g = n * (n - 1) Then
w = 0
For j = 0 To n - 1
w = w + a(n * j + n - 1 - 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 Integer, j As Integer, s As Integer, am As Integer, w As Integer
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(i)
Next
cn = cn + 1
tobi:
End Sub
Private Sub CommandButton2_Click()
Rows("5:20000").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
解説
