第１３話 Ver.1の完成
Ver.1コード
Dim m(9, 9) As Byte, cn As Byte, onf(9, 9, 9) As Byte, ls(9, 9, 9) As Byte, lcn(9, 9) As Byte
Dim khs As Byte, yk(81) As Byte, xk(81) As Byte, tm As Byte
Private Sub CommandButton1_Click()
hj = Timer
tm = 0
cn = 0
dainyuu
kouzoukaiseki
'hyouji
'zahyousakusei (0)
'hyouji2
f (0)
ow = Timer
Cells(6, 12) = "作成時間は"
Cells(6, 13) = ow - hj
Cells(6, 14) = "秒です。"
End Sub
Sub dainyuu()
Dim i As Byte, j As Byte
For i = 0 To 8
For j = 0 To 8
m(i, j) = Cells(3 + i, 2 + j)
Next
Next
For i = 0 To 8
For j = 0 To 8
If m(i, j) < 1 Then
m(i, j) = 0
End If
Next
Next
End Sub
Sub kouzoukaiseki()
Dim i As Byte, j As Byte, k As Byte, l As Byte, si As Byte, sj As Byte
khs = 0
For i = 0 To 8
For j = 0 To 8
If m(i, j) = 0 Then
yk(khs) = i
xk(khs) = j
khs = khs + 1
For k = 0 To 8
onf(i, j, k) = 1
Next
For k = 0 To 8
If m(i, k) > 0 Then onf(i, j, m(i, k) - 1) = 0
Next
For k = 0 To 8
If m(k, j) > 0 Then onf(i, j, m(k, j) - 1) = 0
Next
si = Int(i / 3)
sj = Int(j / 3)
For k = 0 To 2
For l = 0 To 2
If 3 * si + k <> i And 3 * sj + l <> j Then If m(3 * si + k, 3 * sj + l) > 0 Then onf(i, j, m(3 * si + k, 3 * sj + l) - 1) = 0
Next
Next
End If
lcn(i, j) = 0
For k = 0 To 8
If onf(i, j, k) = 1 Then
ls(i, j, lcn(i, j)) = k + 1
lcn(i, j) = lcn(i, j) + 1
End If
Next
Next
Next
End Sub
Sub hyouji()
Dim i As Byte, j As Byte, k As Byte
For i = 0 To 8
For j = 0 To 8
If m(i, j) = 0 Then Cells(13 + i, 2 + j) = lcn(i, j)
If m(i, j) > 0 Then Cells(13 + i, 2 + j) = "*"
Next
Next
End Sub
Sub zahyousakusei(g As Byte)
Dim i As Byte, j As Byte, w As Byte, min As Byte, ik As Byte, jk As Byte, k As Byte
min = 10
For i = g To khs - 1
If lcn(yk(i), xk(i)) < min Then
min = lcn(yk(i), xk(i))
ik = yk(i)
jk = xk(i)
k = i
End If
Next
w = yk(g)
yk(g) = ik
yk(k) = w
w = xk(g)
xk(g) = jk
xk(k) = w
If g + 1 < khs - 1 Then
zahyousakusei (g + 1)
If tm = 1 Then Exit Sub
Else
tm = 1
Exit Sub
End If
End Sub
Sub hyouji2()
Dim i As Byte, j As Byte, k As Byte
For i = 0 To khs - 1
Cells(13 + yk(i), 2 + xk(i)) = i
Next
End Sub
Sub f(g As Integer)
Dim x As Byte, y As Byte
Dim i, j, k, zy, zx As Byte
y = g Mod 9
x = Int(g / 9)
If m(y, x) > 0 Then
If g + 1 < 81 Then
f (g + 1)
Else
For j = 0 To 8
For k = 0 To 8
Cells(13 + j, 2 + k) = m(j, k)
Next
Next
cn = cn + 1
If cn = 1 Then Exit Sub
End If
Exit Sub
End If
Dim xs As Byte, ys As Byte, kk As Byte, kkk As Byte, ow As Byte
ow = lcn(y, x) - 1
xs = Int(x / 3)
ys = Int(y / 3)
For i = 0 To ow
m(y, x) = ls(y, x, i)
For j = 0 To 8
If j <> y Then
If m(y, x) = m(j, x) Then GoTo tobi
End If
Next
For j = 0 To 8
If j <> x Then
If m(y, x) = m(y, j) Then GoTo tobi
End If
Next
For j = 0 To 2
For k = 0 To 2
If 3 * ys + j <> y And 3 * xs + k <> x Then
If m(y, x) = m(3 * ys + j, 3 * xs + k) Then GoTo tobi
End If
Next
Next
If g + 1 < 81 Then
f (g + 1)
Else
For j = 0 To 8
For k = 0 To 8
Cells(13 + j, 2 + k) = m(j, k)
Next
Next
cn = cn + 1
If cn = 1 Then Exit Sub
End If
If cn = 1 Then Exit Sub
tobi:
Next
m(y, x) = 0
End Sub
Private Sub CommandButton2_Click()
Rows("3:11").Select
Selection.ClearContents
Rows("13:32").Select
Selection.ClearContents
Cells(2, 1).Select
End Sub
ポイントは
y = g Mod 9
x = Int(g / 9)
要するに転置してあります。
なぜか転置（行と列を逆にする）するだけでかなり速くなるのです。
でもこれも謎です。
問題作成ソフトは、転置に関しては対称になっているはずであるからです。
今回は、不可解な点が２つも残り気持ちの悪い幕切れで申し訳ありません。
謎を解明できた方は、是非メールをしていただければと思います。
さて、次講は１０進数を２進数や３進数など任意の進数に翻訳するプログラムを考えます。
第１２話へ 第２４講第１話へ
VBA講義第１部へ
vc++講義へ
vb講義へ
ＶＢ講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
数学研究室に戻る
