第２３講　数独を解くソフト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
Private Sub CommandButton1_Click()
　　hj = Timer
　　cn = 0
　　dainyuu
　　kouzoukaiseki
　　hyouji
　　'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
　　For i = 0 To 8
　　　　For j = 0 To 8
　　　　　　If m(i, j) = 0 Then
　　　　　　　　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 f(g As Integer)
　　Dim x As Byte, y As Byte
　　Dim i, j, k, zy, zx As Byte
　　y = Int(g / 9)
　　x = g Mod 9
　　If m(x, y) > 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 xa As Byte, ya As Byte, xs As Byte, ys As Byte, kk As Byte, kkk As Byte
　　xa = x Mod 3
　　ya = y Mod 3
　　xs = Int(x / 3)
　　ys = Int(y / 3)
　　kk = 9 * Rnd()
　　For i = 1 To 9
　　　　kkk = (kk + 4 * i) Mod 9 + 1
　　　　m(x, y) = kkk
　　　　
　　　　For j = 0 To 8
　　　　　　If j <> x Then
　　　　　　　　If m(x, y) = m(j, y) Then GoTo tobi
　　　　　　End If
　　　　Next
　　　
　　　　For j = 0 To 8
　　　　　　If j <> y Then
　　　　　　　　If m(x, y) = m(x, j) Then GoTo tobi
　　　　　　End If
　　　　Next
　　　　For j = 0 To 2
　　　　　　For k = 0 To 2
　　　　　　　　If 3 * xs + j <> x And 3 * ys + k <> y Then
　　　　　　　　　　If m(x, y) = m(3 * xs + j, 3 * ys + 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(x, y) = 0
End Sub
Private Sub CommandButton2_Click()
　　Rows("3:11").Select
　　Selection.ClearContents
　　Rows("13:22").Select
　　Selection.ClearContents
　　Cells(2, 1).Select
End Sub
実行例

構造解析に成功しました。
では、条件の厳しい順に入力して行くにはどうしたらよいでしょうか。


第６話へ　第８話へ

　　


VBA講義第１部へ
vc++講義へ
vb講義へ
ＶＢ講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ

数学研究室に戻る