第17講 末項確定法(魔方陣作成マクロVer.3)への挑戦
第3話 末項確定法版自動実験とVer.3完成コード
コード例
Dim mah(6, 6) As Byte, x(36) As Byte, y(36), sh(20) As Byte, d As Byte, p(36) As Byte, min As Integer
Dim n As Byte, cn As Integer
Dim sk As Long, c As Long
Dim kz As Byte, kz2 As Integer
Private Sub
CommandButton1_Click()
Dim i, j As Integer
n = Cells(3, 8)
If n = 4 Then
sh(0) = 1
sh(1) =
3
sh(2) = 5
sh(3) = 7
sh(4) = 9
sh(5) =
11
sh(6) = 13
sh(7) = 15
End If
If n = 5
Then
sh(0) = 1
sh(1) = 2
sh(2) = 3
sh(3) =
4
sh(4) = 6
sh(5) = 7
sh(6) = 8
sh(7) =
9
sh(8) = 11
sh(9) = 12
sh(10) = 13
sh(11) =
14
sh(12) = 16
sh(13) = 17
sh(14) = 18
sh(15) =
19
sh(16) = 21
sh(17) = 22
sh(18) = 23
sh(19) =
24
End If
If n = 6 Then
sh(0) = 1
sh(1) = 5
sh(2) =
7
sh(3) = 11
sh(4) = 13
sh(5) = 17
sh(6) =
19
sh(7) = 23
sh(8) = 25
sh(9) = 29
sh(10) =
31
sh(11) = 35
End If
zhy
kz2 = 0
For c = 1 To 10000
h = 0
If n = 4 Then
kk = 7
If n = 5 Then kk = 19
If n = 6 Then kk = 11
kz =
0
For d = 0 To kk
sk = 0
cn = 0
Rnd
(-1) '乱数系列の初期化、これがないとRandomizeで番号を指定しても反映されない。
Randomize
(c) '乱数系列の指定。Rnd(-1)とセットで使う。
ms (0)
If cn = 1 Then h =
1
Next
If h = 1 Then
Cells(5 + kz2, 1) = c
kz2 =
kz2 + 1 '行位置調整
End If
Next
End Sub
・
・
・
Sub ms(g As Byte)
Dim i As Integer, j As Byte, k As Byte, a As Byte, b As Byte, w As Integer,
sa As Integer, h As Byte
Dim ii As Integer, iii As Integer, kk As Byte
a = x(g)
b = y(g)
If a = n - 1 And b = n - 1 Then
w = 0
For i = 0 To n - 2
w = w + mah(i, i)
Next
sa = Int(n * (n * n + 1) / 2) - w
If sa < 1 Or sa > n * n Then Exit Sub
If p(sa - 1) = 1 Then Exit Sub
mah(b, a) = sa
p(sa - 1) = 1
ms (g + 1)
p(sa - 1) = 0
Exit Sub
End If
If a = 0 And b = n - 1 Then
w = 0
For i = 0 To n - 2
w = w + mah(i, n - 1 - i)
Next
sa = Int(n * (n * n + 1) / 2) - w
If sa < 1 Or sa > n * n Then Exit Sub
If p(sa - 1) = 1 Then Exit Sub
mah(b, a) = sa
p(sa - 1) = 1
ms (g + 1)
p(sa - 1) = 0
Exit Sub
End If
If a = n - 2 And b = 0 Then
w = 0
For i = 0 To n - 3
w = w + mah(b, i)
Next
w = w + mah(b, n - 1)
sa = Int(n * (n * n + 1) / 2) - w
If sa < 1 Or sa > n * n Then Exit Sub
If p(sa - 1) = 1 Then Exit Sub
mah(b, a) = sa
p(sa - 1) = 1
ms (g + 1)
p(sa - 1) = 0
Exit Sub
End If
If a = 0 And b = n - 2 Then
w = 0
For i = 0 To n - 3
w = w + mah(i, a)
Next
w = w + mah(n - 1, a)
sa = Int(n * (n * n + 1) / 2) - w
If sa < 1 Or sa > n * n Then Exit Sub
If p(sa - 1) = 1 Then Exit Sub
mah(b, a) = sa
p(sa - 1) = 1
ms (g + 1)
p(sa - 1) = 0
Exit Sub
End If
If a = n - 1 And b > 0 And b < n - 1 Then
w = 0
For i = 0 To n - 2
w = w + mah(b, i)
Next
sa = Int(n * (n * n + 1) / 2) - w
If sa < 1 Or sa > n * n Then Exit Sub
If p(sa - 1) = 1 Then Exit Sub
mah(b, a) = sa
p(sa - 1) = 1
ms (g + 1)
p(sa - 1) = 0
Exit Sub
End If
If a > 0 And a < n - 1 And b = n - 1 Then
w = 0
For i = 0 To n - 2
w = w + mah(i, a)
Next
sa = Int(n * (n * n + 1) / 2) - w
If sa < 1 Or sa > n * n Then Exit Sub
If p(sa - 1) = 1 Then Exit Sub
mah(b, a) = sa
p(sa - 1) = 1
If g + 1 < n * n Then
ms (g + 1)
Else
'For j = 0 To n - 1
'For k = 0 To n - 1
'Cells(6 + k + Int(cn / 10) * (n + 1), 1 + j + (cn Mod 10) *
(n + 1)) = mah(j, k)
'Next
'Next
cn = cn + 1
Cells(5 + kz2, 3 + 2 * kz) = sh(d) 'dではなくsh(d)を表示するように変更、こうしないとsh(3) = 11等によっていちいち翻訳が必要になる。
Cells(5 + kz2, 4 + 2 * kz) = sk
If sk < min Then '最小値を実行画面の中から探さなくてもよいように変更。
min = sk
Cells(1, 6) = min
Cells(2, 6) = c
Cells(3, 6) = sh(d)
End If
kz = kz + 1
If cn = 1 Then Exit Sub
End If
p(sa - 1) = 0
Exit Sub
End If
・
・
・
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
ms (g + 1)
tobi:
If h = 1 Then p(mah(b, a) - 1) = 0
Next
End Sub
実行画面例
実験をもとに完成したVer.3のコード
Dim mah(6, 6) As Byte, x(36) As Byte, y(36) As Byte, p(36) As Byte
Dim n As Byte, cn As Integer
Private Sub CommandButton1_Click()
Dim i, j As Integer
n = Cells(3, 8)
Rnd (-1)
If n = 4 Then Randomize (425)
If n = 5 Then Randomize (24)
If n = 6 Then Randomize (4768)
syokika
zhy
ms (0)
End Sub
・
・
・
Sub ms(g As Byte)
・
・
・
If a > 0 And a < n - 1 And b = n - 1 Then
w = 0
For i = 0 To n - 2
w = w + mah(i, a)
Next
sa = Int(n * (n * n + 1) / 2) - w
If sa < 1 Or sa > n * n Then Exit Sub
If p(sa - 1) = 1 Then Exit Sub
mah(b, a) = sa
p(sa - 1) = 1
If g + 1 < n * n Then
ms (g + 1)
Else
For j = 0 To n - 1
For k = 0 To n - 1
Cells(6 + k + Int(cn / 10) * (n + 1), 1 + j + (cn Mod 10) * (n
+ 1)) = mah(j, k)
Next
Next
cn = cn + 1
Cells(4, 12) = cn
End If
p(sa - 1) = 0
Exit Sub
End If
ii = n * n * Rnd
If n = 4 Then kk = 3
If n = 5 Then kk = 13
If n = 6 Then kk = 11
If n = 3 Then kk = 1
For i = 0 To n * n - 1
iii = (ii + kk * i) Mod n * n
・
・
・
Next
End Sub
完成Ver.3ファイル
さて、Ver.3が完成しました。
Ver.2とVer.3のそれぞれについて時間計測が出来るようにして、
どのぐらい速くなったかを確認しましょう。
コードを考えましょう。
第2話へ 第4話へ
VBA講義第1部へ
vc++講義へ
vb講義へ
VB講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
数学研究室に戻る