第12講プロシージャの再帰的使用によって魔方陣を自動生成する第９話魔方陣自動生成ソフトの高速化

第12講プロシージャの再帰的使用によって魔方陣を自動生成する
第９話魔方陣自動生成ソフトの高速化

vba

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())
'　　hyouji (n)　　'番号付けが上手くいっているかの確認　上手くいっていることが確認できたら'をつけて注釈文に変更する。
　　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)
'　　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, iz() As Byte, jz() 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 = iz(g)
　　gj = jz(g)
　　For i = 1 To n * n
　　　　x(gi, gj) = i
　　　　h = 1
　　　　If g > 0 Then
　　　　　　For j = 0 To g - 1
　　　　　　　　ji = iz(j)
　　　　　　　　jj = jz(j)
　　　　　　　　If x(ji, jj) = x(gi, gj) Then
　　　　　　　　　　h = 0
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　　　If h = 1 Then
　　　　　　If gj = n - 2 And gi = 0 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 gj = n - 1 And gi > 0 And g > n 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 - 2 And gj = 0 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 And g > 2 * n 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(), iz(), jz())
　　　　　　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
参考ファイル

解説は次話で行います。

第８話へ　　第10話へ

初心者のためのc++ vc++ c言語入門基礎から応用までへ
 初心者のための excel 2007 2010 2013 vba マクロ入門基礎から応用まで
 初心者のための世界で一番わかりやすいVisual C++入門基礎講座
 初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
 vb講義トップへ
 ＶＢ講義基礎へ
 専門用語なしのC++入門へ
 専門用語なしのJava入門へ
専門用語なしのVBA入門

数独のページ
 魔方陣のページ
 数学研究室に戻る
 本サイトトップへ