第１１話 厳しい順にランク付けする
解答例
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
さて、厳しい順の座標作成に成功しました。
Ver.1の完成へ向けて進みますが、
今回はまったく予想外の結論になってしまいます。
前に言ったことを訂正して、リスト内容まで考慮に入れた版を完成版とします。
第１０話へ 第１２話へ
VBA講義第１部へ
vc++講義へ
vb講義へ
ＶＢ講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
数学研究室に戻る
