Dim mah1(12, 12) As Byte, mah2(12, 12) As Byte, x(144) As Byte, y(144) As Byte, p1(144) As Byte, p2(144) As Byte, a(12, 12) As Integer
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)
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
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
Rnd (-1)
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
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
tm = 0
sk = 0
cn = 0
gk = n
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 > 2000 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)
If p1(sa) > 0 Then 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)
If p1(sa) > 0 Then 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)
If p1(sa) > 0 Then 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)
If p1(sa) > 0 Then 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)
If p1(sa) > 0 Then 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
If p1(sa) > 0 Then 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 If p1(mah1(b, a)) > 0 Then p1(mah1(b, a)) = p1(mah1(b, a)) - 1
If cn = 1 Then Exit Sub
If sk > 2000 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 > 2000 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 > 2000 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入門基礎講座へ
数学研究室に戻る
