第１３話へ 第１５話へ
VBA講義第１部へ
vc++講義へ
vb講義へ
ＶＢ講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
数学研究室に戻る
第１８講 一般種法×末項確定法（魔方陣作成マクロVer.4）への挑戦
第１４話 最適値自動探索プログラムの謎の解明と改良コード
前話の謎が２つとも解けました。
Sub syokika1()
Dim i As Byte
Dim j As Byte
For i = 0 To n - 1
For j = 0 To n - 1
a(i, j) = -1
Next
Next
End Sub
に問題がありました。これを
Sub syokika1()
Dim i As Byte
Dim j As Byte
For i = 0 To n - 1
For j = 0 To n - 1
a(i, j) = -1
Next
Next
gk = n
End Sub
とすれば前話の２つの奇妙な振る舞いは消えます。
改善コードを載せておきましょう。
Dim th(12, 12) As Byte
Dim gk As Integer, tm As Byte
Dim sh(10) As Byte, sh1(10) As Byte, d As Byte, e 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 As Integer, j As Integer, kk As Byte
min = 10000
n = Cells(3, 8)
syokika1
zhy
zhy1 (0)
kz2 = 0
For c = 1 To 10000
h = 0
kz = 0
If n = 4 Then kk = 1
If n = 5 Then kk = 3
If n = 6 Then kk = 1
If n = 7 Then kk = 5
If n = 8 Then kk = 3
If n = 9 Then kk = 5
If n = 10 Then kk = 3
If n = 11 Then kk = 10
If n = 12 Then kk = 3
For d = 0 To kk
For e = 0 To kk
syokika
Randomize (c)
ms1 (0)
If cn = 1 Then h = 1
Next
Next
If h = 1 Then
Cells(6 + kz2, 1) = c
kz2 = kz2 + 1
End If
Next
End Sub
Sub syokika1()
Dim i As Byte
Dim j As Byte
For i = 0 To n - 1
For j = 0 To n - 1
a(i, j) = -1
Next
Next
If n = 4 Then 'この初期化データは大きすぎるのでこちらに移動しました。
sh(0) = 1
sh(1) = 3
End If
If n = 5 Then
sh(0) = 1
sh(1) = 2
sh(2) = 3
sh(3) = 4
End If
If n = 6 Then
sh(0) = 1
sh(1) = 5
End If
If n = 7 Then
sh(0) = 1
sh(1) = 2
sh(2) = 3
sh(3) = 4
sh(4) = 5
sh(5) = 6
End If
If n = 8 Then
sh(0) = 1
sh(1) = 3
sh(2) = 5
sh(3) = 7
End If
If n = 9 Then
sh(0) = 1
sh(1) = 2
sh(2) = 4
sh(3) = 5
sh(4) = 7
sh(5) = 8
End If
If n = 10 Then
sh(0) = 1
sh(1) = 3
sh(2) = 7
sh(3) = 9
End If
If n = 11 Then
sh(0) = 1
sh(1) = 2
sh(2) = 3
sh(3) = 4
sh(4) = 5
sh(5) = 6
sh(6) = 7
sh(7) = 8
sh(8) = 9
sh(9) = 10
End If
If n = 12 Then
sh(0) = 1
sh(1) = 5
sh(2) = 7
sh(3) = 11
End If
If n = 4 Then
sh1(0) = 1
sh1(1) = 3
End If
If n = 5 Then
sh1(0) = 1
sh1(1) = 2
sh1(2) = 3
sh1(3) = 4
End If
If n = 6 Then
sh1(0) = 1
sh1(1) = 5
End If
If n = 7 Then
sh1(0) = 1
sh1(1) = 2
sh1(2) = 3
sh1(3) = 4
sh1(4) = 5
sh1(5) = 6
End If
If n = 8 Then
sh1(0) = 1
sh1(1) = 3
sh1(2) = 5
sh1(3) = 7
End If
If n = 9 Then
sh1(0) = 1
sh1(1) = 2
sh1(2) = 4
sh1(3) = 5
sh1(4) = 7
sh1(5) = 8
End If
If n = 10 Then
sh1(0) = 1
sh1(1) = 3
sh1(2) = 7
sh1(3) = 9
End If
If n = 11 Then
sh1(0) = 1
sh1(1) = 2
sh1(2) = 3
sh1(3) = 4
sh1(4) = 5
sh1(5) = 6
sh1(6) = 7
sh1(7) = 8
sh1(8) = 9
sh1(9) = 10
End If
If n = 12 Then
sh1(0) = 1
sh1(1) = 5
sh1(2) = 7
sh1(3) = 11
End If
tm = 0
gk = n 'これがなかったので奇妙奇天烈摩訶不思議な現象が起きた。
End Sub
Sub syokika()
Dim i As Byte
Dim j As Byte
For i = 0 To n - 1
p1(i) = 0
p2(i) = 0
For j = 0 To n - 1
th(i, j) = 0
Next
Next
For i = 0 To n - 1
For j = 0 To n - 1
mah1(i, j) = 0
mah2(i, j) = 0
Next
Next
sk = 0
cn = 0
gk = n
Rnd (-1)
End Sub
Sub zhy()
Dim i As Byte
For i = 0 To n - 1
a(i, i) = i
Next
For i = 0 To n - 1
If a(i, n - 1 - i) = -1 Then
a(i, n - 1 - i) = gk
gk = gk + 1
End If
Next
End Sub
Sub zhy1(g As Byte)
Dim i As Byte
For i = g + 1 To n - 1
If a(g, i) = -1 Then
a(g, i) = gk
gk = gk + 1
End If
Next
zhy2 (g)
If tm = 1 Then Exit Sub
End Sub
Sub zhy2(g As Byte)
Dim i As Byte
Dim j As Byte
For i = g + 1 To n - 1
If a(i, g) = -1 Then
a(i, g) = gk
gk = gk + 1
End If
Next
If g + 1 < n Then
zhy1 (g + 1)
If tm = 1 Then Exit Sub
Else
For i = 0 To n - 1
For j = 0 To n - 1
y(a(i, j)) = i
x(a(i, j)) = j
Next
Next
tm = 1
Exit Sub
End If
End Sub
Sub zhykakunin()
Dim i As Byte
For i = 0 To n * n - 1
Cells(5 + y(i), 1 + x(i)) = i
Next
End Sub
Sub ms1(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
If cn = 1 Then Exit Sub
If sk > 3000 Then Exit Sub
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 + mah1(i, i)
Next
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If p1(sa) >= n Then Exit Sub
mah1(b, a) = sa
p1(sa) = p1(sa) + 1
ms1 (g + 1)
p1(sa) = p1(sa) - 1
Exit Sub
End If
If a = 0 And b = n - 1 Then
w = 0
For i = 0 To n - 2
w = w + mah1(i, n - 1 - i)
Next
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If p1(sa) >= n Then Exit Sub
mah1(b, a) = sa
p1(sa) = p1(sa) + 1
ms1 (g + 1)
p1(sa) = p1(sa) - 1
Exit Sub
End If
If a = n - 2 And b = 0 Then
w = 0
For i = 0 To n - 3
w = w + mah1(b, i)
Next
w = w + mah1(b, n - 1)
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If p1(sa) >= n Then Exit Sub
mah1(b, a) = sa
p1(sa) = p1(sa) + 1
ms1 (g + 1)
p1(sa) = p1(sa) - 1
Exit Sub
End If
If a = 0 And b = n - 2 Then
w = 0
For i = 0 To n - 3
w = w + mah1(i, a)
Next
w = w + mah1(n - 1, a)
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If p1(sa) >= n Then Exit Sub
mah1(b, a) = sa
p1(sa) = p1(sa) + 1
ms1 (g + 1)
p1(sa) = p1(sa) - 1
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 + mah1(b, i)
Next
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If p1(sa) >= n Then Exit Sub
mah1(b, a) = sa
p1(sa) = p1(sa) + 1
ms1 (g + 1)
p1(sa) = p1(sa) - 1
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 + mah1(i, a)
Next
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If p1(sa) >= n Then Exit Sub
mah1(b, a) = sa
p1(sa) = p1(sa) + 1
If g + 1 < n * n Then
ms1 (g + 1)
Else
ms2 (0)
End If
p1(sa) = p1(sa) - 1
Exit Sub
End If
ii = n * Rnd
For i = 0 To n - 1
iii = (ii + sh(d) * i) Mod n
mah1(b, a) = iii
h = 0
If p1(mah1(b, a)) >= n Then GoTo tobi
p1(mah1(b, a)) = p1(mah1(b, a)) + 1
h = 1
ms1 (g + 1)
sk = sk + 1
tobi:
If h = 1 Then p1(mah1(b, a)) = p1(mah1(b, a)) - 1
If cn = 1 Then Exit Sub
If sk > 3000 Then Exit Sub
Next
mah1(b, a) = 0
End Sub
Sub ms2(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, hs As Integer
If cn = 1 Then Exit Sub
If sk > 3000 Then Exit Sub
a = x(g)
b = y(g)
hs = mah1(b, a)
If a = n - 1 And b = n - 1 Then
w = 0
For i = 0 To n - 2
w = w + mah2(i, i)
Next
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If th(mah1(b, a), sa) = 1 Then Exit Sub
If p2(sa) >= n Then Exit Sub
mah2(b, a) = sa
p2(sa) = p2(sa) + 1
th(mah1(b, a), mah2(b, a)) = 1
ms2 (g + 1)
p2(sa) = p2(sa) - 1
th(mah1(b, a), mah2(b, a)) = 0
Exit Sub
End If
If a = 0 And b = n - 1 Then
w = 0
For i = 0 To n - 2
w = w + mah2(i, n - 1 - i)
Next
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If th(mah1(b, a), sa) = 1 Then Exit Sub
If p2(sa) >= n Then Exit Sub
mah2(b, a) = sa
p2(sa) = p2(sa) + 1
th(mah1(b, a), mah2(b, a)) = 1
ms2 (g + 1)
p2(sa) = p2(sa) - 1
th(mah1(b, a), mah2(b, a)) = 0
Exit Sub
End If
If a = n - 2 And b = 0 Then
w = 0
For i = 0 To n - 3
w = w + mah2(b, i)
Next
w = w + mah2(b, n - 1)
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If th(mah1(b, a), sa) = 1 Then Exit Sub
If p2(sa) >= n Then Exit Sub
mah2(b, a) = sa
p2(sa) = p2(sa) + 1
th(mah1(b, a), mah2(b, a)) = 1
ms2 (g + 1)
p2(sa) = p2(sa) - 1
th(mah1(b, a), mah2(b, a)) = 0
Exit Sub
End If
If a = 0 And b = n - 2 Then
w = 0
For i = 0 To n - 3
w = w + mah2(i, a)
Next
w = w + mah2(n - 1, a)
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If th(mah1(b, a), sa) = 1 Then Exit Sub
If p2(sa) >= n Then Exit Sub
mah2(b, a) = sa
p2(sa) = p2(sa) + 1
th(mah1(b, a), mah2(b, a)) = 1
ms2 (g + 1)
p2(sa) = p2(sa) - 1
th(mah1(b, a), mah2(b, a)) = 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 + mah2(b, i)
Next
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If th(mah1(b, a), sa) = 1 Then Exit Sub
If p2(sa) >= n Then Exit Sub
mah2(b, a) = sa
p2(sa) = p2(sa) + 1
th(mah1(b, a), mah2(b, a)) = 1
ms2 (g + 1)
p2(sa) = p2(sa) - 1
th(mah1(b, a), mah2(b, a)) = 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 + mah2(i, a)
Next
sa = Int(n * (n - 1) / 2) - w
If sa < 0 Or sa > (n - 1) Then Exit Sub
If th(mah1(b, a), sa) = 1 Then Exit Sub
If p2(sa) >= n Then Exit Sub
mah2(b, a) = sa
p2(sa) = p2(sa) + 1
th(mah1(b, a), mah2(b, a)) = 1
If g + 1 < n * n Then
ms2 (g + 1)
Else
cn = cn + 1
Cells(6 + kz2, 2 + 3 * kz) = sh(d)
Cells(6 + kz2, 3 + 3 * kz) = sh(e)
Cells(6 + kz2, 4 + 3 * kz) = sk
If sk < min Then
min = sk
Cells(1, 7) = min
Cells(2, 7) = c
Cells(3, 7) = sh(d)
Cells(4, 7) = sh1(e)
End If
kz = kz + 1
If cn = 1 Then Exit Sub
End If
p2(sa) = p2(sa) - 1
th(mah1(b, a), mah2(b, a)) = 0
Exit Sub
End If
ii = n * Rnd
For i = 0 To n - 1
iii = (ii + sh(e) * i) Mod n
mah2(b, a) = iii
h = 0
If p2(mah2(b, a)) >= n Then GoTo tobi
If th(mah1(b, a), mah2(b, a)) = 1 Then GoTo tobi
p2(mah2(b, a)) = p2(mah2(b, a)) + 1
th(mah1(b, a), mah2(b, a)) = 1
h = 1
ms2 (g + 1)
sk = sk + 1
tobi:
If h = 1 Then
p2(mah2(b, a)) = p2(mah2(b, a)) - 1
th(mah1(b, a), mah2(b, a)) = 0
End If
If cn = 1 Then Exit Sub
If sk > 3000 Then Exit Sub
Next
mah2(b, a) = 0
End Sub
Private Sub CommandButton2_Click()
Rows("6:20000").Select
Selection.ClearContents
Cells(4, 12).Select
Selection.ClearContents
Range("G1:G4").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
ダウンロード用参考ファイル
第１３話へ 第１５話へ
VBA講義第１部へ
vc++講義へ
vb講義へ
ＶＢ講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
数学研究室に戻る
