Private Sub CommandButton1_Click()
Dim n As Byte, cn As Integer, x(10, 10) As Byte
Dim iz(100) As Byte, jz(100) As Byte
Rows("5").Select
Selection.ClearContents
Range("A1").Select
n = Cells(3, 11)
cn = 0
Call zahyousakusei(n, iz(), jz())
Call hyouji(n, iz(), jz()) '番号付けが上手くいっているかの確認 上手くいっていることが確認できたら'をつけて注釈文に変更する。
' Call f(0, cn, n, x(), iz(), jz())
' Cells(5, 14) = n
' Cells(5, 15) = "次魔方陣は"
' Cells(5, 20) = cn
' Cells(5, 23) = "個存在しました。"
End Sub
Sub hyouji(n As Byte, iz() As Byte, jz() As Byte)
Dim i As Byte, j As Byte, a(10, 10) As Byte
For i = 0 To n * n - 1
a(iz(i), jz(i)) = i
Next
For i = 0 To n - 1
For j = 0 To n - 1
Cells(6 + i, 2 + j) = a(i, j)
Next
Next
End Sub
Sub zahyousakusei(n As Byte, iz() As Byte, jz() As Byte)
Dim i As Byte, j As Byte, a(10, 10) As Byte, c As Byte
For i = 0 To n - 1
For j = 0 To n - 1
a(i, j) = 128
Next
Next
For i = 0 To n - 1
a(i, i) = i
Next
c = n
For i = 0 To n - 1
If a(i, n - 1 - i) = 128 Then
a(i, n - 1 - i) = c
c = c + 1
End If
Next
For i = 0 To n - 1
For j = 0 To n - 1
If a(i, j) = 128 Then
a(i, j) = c
c = c + 1
End If
Next
Next
For i = 0 To n - 1
For j = 0 To n - 1
iz(a(i, j)) = i
jz(a(i, j)) = j
Next
Next
End Sub
参考ファイル
さて、番号付けに成功しましたので、
いよいよ Sub f(g As Byte, cn As Integer, n As Byte, x() As Byte)
Dim h As Byte, i As Byte, j As Byte, k As Byte, a As Byte, s As Integer, gi As Byte, gj As Byte
Dim ji As Byte, jj As Byte, hh As Byte, w As Byte
a = cn Mod 10
s = Int(cn / 10)
gi = Int(g / n)
gj = g Mod n
For i = 1 To n * n
x(gi, gj) = i
h = 1
If g > 0 Then
For j = 0 To g - 1
ji = Int(j / n)
jj = j Mod n
If x(ji, jj) = x(gi, gj) Then
h = 0
Exit For
End If
Next
End If
If h = 1 Then
If gj = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + x(gi, j)
Next
If w <> Int(n * (n * n + 1) / 2) Then h = 0
End If
End If
If h = 1 Then
If gi = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + x(j, gj)
Next
If w <> Int(n * (n * n + 1) / 2) Then h = 0
End If
End If
If h = 1 Then
If gi = n - 1 And gj = 0 Then
w = 0
For j = 0 To n - 1
w = w + x(j, n - 1 - j)
Next
If w <> Int(n * (n * n + 1) / 2) Then h = 0
End If
End If
If h = 1 Then
If gi = n - 1 And gj = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + x(j, j)
Next
If w <> Int(n * (n * n + 1) / 2) Then h = 0
End If
End If
If h = 1 Then
If g + 1 < n * n Then
Call f(g + 1, cn, n, x())
Else
For j = 0 To n - 1
For k = 0 To n - 1
Cells(7 + j + (n + 1) * s, 2 + k + (n + 1) * a) = x(j, k)
Next
Next
cn = cn + 1
End If
End If
Next
End Sub
を改良します。
gi = Int(g / n)
gj = g Mod n
ji = Int(j / n)
jj = j Mod n
の４行を変更し、 If h = 1 Then
If gj = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + x(gi, j)
Next
If w <> Int(n * (n * n + 1) / 2) Then h = 0
End If
End If
If h = 1 Then
If gi = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + x(j, gj)
Next
If w <> Int(n * (n * n + 1) / 2) Then h = 0
End If
End If
を改良しなければなりません。
どうしてでしょうか。
ヒントは
