第８話 数独（ナンプレ）の問題を解くソフトの完成
プログラム全文
Dim mah(8, 8) As Byte, lst(8, 8, 8) As Byte, mx(8, 8) As Byte, h(8, 8, 8) As Byte, cn As Byte
Private Sub CommandButton1_Click()
Dim i As Byte, j As Byte, hajime As Variant, owari As Variant
hajime = Timer
dainyuu
syokika
For i = 0 To 8
For j = 0 To 8
If mah(i, j) = 0 Then
Call cellkaiseki1(i, j)
Call cellkaiseki2(i, j)
End If
Next
Next
f (0)
owari = Timer
Cells(7, 13) = "解くのにかかった時間は"
Cells(8, 13) = owari - hajime
Cells(9, 13) = "秒です。"
End Sub
Sub dainyuu()
Dim i As Byte, j As Byte
For i = 0 To 8
For j = 0 To 8
If Cells(4 + i, 2 + j) = "" Then mah(i, j) = 0 Else mah(i, j) = Cells(4 + i, 2 + j)
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
Cells(14 + i, 2 + j) = mah(i, j)
Next
Next
End Sub
Sub syokika()
Dim i As Byte, ja As Byte, k As Byte
cn = 0
For i = 0 To 8
For j = 0 To 8
For k = 0 To 8
h(i, j, k) = 1
lst(i, j, k) = k + 1
Next
Next
Next
End Sub
Sub cellkaiseki1(i As Byte, j As Byte)
Dim k As Byte, l As Byte
For k = 0 To 8
If mah(i, k) > 0 Then h(i, j, mah(i, k) - 1) = 0
Next
For k = 0 To 8
If mah(k, j) > 0 Then h(i, j, mah(k, j) - 1) = 0
Next
For k = 0 To 2
For l = 0 To 2
If 3 * Int(i / 3) + k <> i And 3 * Int(j / 3) + l <> j Then
If mah(3 * Int(i / 3) + k, 3 * Int(j / 3) + l) > 0 Then h(i, j, mah(3 * Int(i / 3) + k, 3 * Int(j / 3) + l) - 1) = 0
End If
Next
Next （2014/12/07訂正）
End Sub
Sub cellkaiseki2(i As Byte, j As Byte)
Dim k As Byte, w As Byte
w = 0
For k = 0 To 8
If h(i, j, k) = 1 Then
lst(i, j, w) = k + 1
w = w + 1
End If
Next
mx(i, j) = w
For k = 0 To 8
If h(i, j, k) = 0 Then
lst(i, j, w) = k + 1
w = w + 1
End If
Next
End Sub
Sub f(g As Byte)
Dim i As Byte, j As Byte, k As Byte
Dim y As Byte, x As Byte
y = Int(g / 9)
x = g Mod 9
If mah(y, x) > 0 Then
If g + 1 < 81 Then
f (g + 1)
If cn = 1 Then Exit Sub
Else
cn = cn + 1
hyouji
If cn = 1 Then Exit Sub
End If
Exit Sub
End If
If mah(y, x) = 0 Then
For i = 0 To mx(y, x) - 1
mah(y, x) = lst(y, x, i)
For j = 0 To 8
If j <> x Then
If mah(y, x) = mah(y, j) Then GoTo tobi
End If
Next
For j = 0 To 8
If j <> y Then
If mah(y, x) = mah(j, x) Then GoTo tobi
End If
Next
For k = 0 To 2
For l = 0 To 2
If y <> 3 * Int(y / 3) + k And x <> 3 * Int(x / 3) + l Then
If mah(y, x) = mah(3 * Int(y / 3) + k, 3 * Int(x / 3) + l) Then GoTo tobi
End If
Next
Next
If g + 1 < 81 Then
f (g + 1)
If cn = 1 Then Exit Sub
Else
cn = cn + 1
hyouji
End If
tobi:
Next
End If
mah(y, x) = 0
End Sub
Private Sub CommandButton2_Click()
Rows("14:200").Select
Selection.ClearContents
Range("M5", "V9").Select
Selection.ClearContents
Cells(2, 1).Select
End Sub
参考ファイル６
実行画面
遂に、ソフトの完成です。
皆さん、数独の問題を問題図に入力して様々な問題を解かせてみて下さい。
一瞬にして解けるはずです。
次の課題です。
消去ボタンを変更して、消去を押すと問題図の方も消えるようにしましょう。
また、数独の解答が複数存在しないかもチェックできるように変更しましょう。
