コード例
Dim mah(6, 6) As Byte, x(36) As Byte, y(36) As Byte
Dim n As Byte, cn As Integer
Private Sub CommandButton1_Click()
n = Cells(3, 8)
cn = 0
zhy
hyouji '動作が確認されたら削除
'ms (0)
'Cells(4, 12) = cn
End Sub
Sub zhy()
Dim i, k As Byte
Dim a(6, 6) As Integer
For i = 0 To n - 1
For j = 0 To n - 1
a(i, j) = -1
Next
Next
For i = 0 To n - 1
a(i, i) = i
Next
k = n
For i = 0 To n - 1
If a(i, n - 1 - i) = -1 Then
a(i, n - 1 - i) = k
k = k + 1
End If
Next
For i = 0 To n - 1
For j = 0 To n - 1
If a(i, j) = -1 Then
a(i, j) = k
k = k + 1
End If
Next
Next
For i = 0 To n - 1
For j = 0 To n - 1
x(a(i, j)) = j
y(a(i, j)) = i
Next
Next
End Sub
'動作が正常であることを確認したら削除する。
Sub hyouji()
Dim i As Byte
For i = 0 To n * n - 1
Cells(6 + y(i), 1 + x(i)) = i
Next
End Sub
Sub ms(g As Byte)
Dim i As Byte, j As Byte, k As Byte, a As Byte, b As Byte, w As Byte
a = x(g)
b = y(g)
For i = 0 To n * n - 1
mah(b, a) = i + 1
If g > 0 Then
For j = 0 To g - 1
If mah(b, a) = mah(y(j), x(j)) Then GoTo tobi
Next
End If
If a = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + mah(b, j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If b = n - 1 Then
w = 0
For j = 0 To n - 1
w = w + mah(j, a)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If (a = n - 1) And (b = n - 1) Then
w = 0
For j = 0 To n - 1
w = w + mah(j, j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If (a = 0) And (b = n - 1) Then
w = 0
For j = 0 To n - 1
w = w + mah(j, n - 1 - j)
Next
If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
End If
If g + 1 < n * n Then
ms (g + 1)
Else
For j = 0 To n - 1
For k = 0 To n - 1
Cells(6 + j + Int(cn / 10) * (n + 1), 1 + k + (cn Mod 10) * (n + 1)) = mah(j, k)
Next
Next
cn = cn + 1
End If
tobi:
Next
End Sub
Private Sub CommandButton2_Click()
Rows("6:2000").Select
Selection.ClearContents
Cells(4, 12).Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
実行画面例
