実現するプログラム例Dim n As Byte, m(8, 8) As Byte, cn As Integer, hnt As Byte 'nは数独の一辺、x(15)は数独を収納する配列、cnは数独総数をカウント、hntはヒント数
Dim iz(80) As Byte, jz(80) As Byte 'iz(80)はｙ座標を収納する配列、jz(80)はｘ座標を収納する配列
Dim cm(8, 8) As Byte 'm(i, j)のバックアップ
Private Sub CommandButton1_Click()
CommandButton2_Click
n = 9
Randomize (Timer) 'シード値を時間から取得
hj = Timer 'はじめの時間取得
Randomize (Timer) 'シード値を時間から取得
dainyu 'シートのB4からJ12のセルからm(i, j)に代入することが任務
f (0) '数独解答作成プロシージ
ow = Timer '終わりの時間取得
hyouji '解答表示
Cells(4, 12) = "問題を解くのにかかった時間は"
Cells(5, 12) = ow - hj
Cells(6, 12) = "秒です。"
If cn = 1 And seigohantei = 1 Then Cells(7, 12) = "正しい解答です。" Else Cells(7, 12) = "誤った解答です。"
End Sub
Function seigohantei() '出来た数独が適正であるか調べるプロシージャ
Dim i As Byte, j As Byte, a(8) As Byte
For i = 0 To n - 1 '問題の数字と解答の同位置の数字が一致しているか調べている
For j = 0 To n - 1
If Cells(4 + i, 2 + j) > 0 Then
If Cells(4 + i, 2 + j) <> Cells(14 + i, 2 + j) Then
seigohantei = 0
Exit Function
End If
End If
If Cells(14 + i, 2 + j) = "" Then '解答に空欄がないかを調べている
seigohantei = 0
Exit Function
End If
Next
Next
For i = 0 To n - 1 '行に１から９までの数字がひとつずつ並んでいるかをチェック
For j = 0 To n - 1
a(j) = 0
Next
For j = 0 To n - 1
a(Cells(14 + i, 2 + j) - 1) = 1
Next
For j = 0 To n - 1
If a(j) = 0 Then
seigohantei = 0
Exit Function
End If
Next
Next
For i = 0 To n - 1 '列に１から９までの数字がひとつずつ並んでいるかをチェック
For j = 0 To n - 1
a(j) = 0
Next
For j = 0 To n - 1
a(Cells(14 + j, 2 + i) - 1) = 1
Next
For j = 0 To n - 1
If a(j) = 0 Then
seigohantei = 0
Exit Function
End If
Next
Next
Dim y As Byte, x As Byte
For i = 0 To n - 1 'ブロックに１から９までの数字がひとつずつ並んでいるかをチェック
For j = 0 To n - 1
a(j) = 0
Next
For j = 0 To n - 1
y = 3 * Int(i / 3) + Int(j / 3)
x = 3 * (i Mod 3) + (j Mod 3)
a(Cells(14 + y, 2 + x) - 1) = 1
Next
For j = 0 To n - 1
If a(j) = 0 Then
seigohantei = 0
Exit Function
End If
Next
Next
seigohantei = 1
End Function
Sub dainyu() 'シートのB4からJ12のセルからm(i, j)に代入することが任務
Dim i As Byte, j As Byte, w As Byte
hnt = 0
w = 0
For i = 0 To n - 1
For j = 0 To n - 1
If Cells(4 + i, 2 + j) > 0 Then
m(i, j) = Cells(4 + i, 2 + j)
hnt = hnt + 1 'ヒント数のカウント
Else
m(i, j) = 0
iz(w) = i '入力順を確定させるためのｙ座標作成
jz(w) = j '入力順を確定させるためのｘ座標作成
w = w + 1
End If
Next
Next
cn = 0
End Sub
Sub f(g As Byte)
Dim i As Byte, j As Byte, k As Byte, h As Byte, w As Byte
Dim y As Byte, x As Byte, yy As Byte, xx As Byte
y = iz(g)
x = jz(g)
For i = 0 To n - 1
m(y, x) = i + 1
h = 1
For j = 0 To n - 1
If j <> x Then '行の座標(y, x)以外のすべてのセルについて重複検査をして、重複している場合にはhを0として以下の処理を実行させない。
If m(y, x) = m(y, j) Then
h = 0
Exit For
End If
End If
Next
If h = 1 Then
For j = 0 To n - 1
If j <> y Then '列の座標(y, x)以外のすべてのセルについて重複検査をして、重複している場合にはhを0として以下の処理を実行させない。
If m(y, x) = m(j, x) Then
h = 0
Exit For
End If
End If
Next
End If
If h = 1 Then
For j = 0 To n - 1
xx = 3 * Int(x / 3) + (j Mod 3)
yy = 3 * Int(y / 3) + Int(j / 3)
If x <> xx Or y <> yy Then 'ブロックの座標(y, x)以外のすべてのセルについて重複検査をして、重複している場合にはhを0として以下の処理を実行させない。
If m(y, x) = m(yy, xx) Then
h = 0
Exit For
End If
End If
Next
End If
If h = 1 Then
If g + 1 < n * n - hnt Then '行・列・ブロックの重複がなく、g + 1がn * n以下のときに、次のセル番号の世界に飛ぶ
f (g + 1)
If cn = 2 Then Exit Sub 'cn = 2となっている理由は別解がないか探索させるため
Else
cn = cn + 1 '数独総数カウント
If cn = 1 Then '別解がないか探索させている間にm(i ,j)は壊されてしまうためにバックアップをとっている。
For j = 0 To n - 1
For k = 0 To n - 1
cm(j, k) = m(j, k)
Next
Next
End If
If cn = 2 Then Exit Sub 'cn = 2となっている理由は別解がないか探索させるため
End If
End If
Next
m(y, x) = 0
End Sub
Sub hyouji()
Dim i As Byte, j As Byte
For i = 0 To n - 1
For j = 0 To n - 1
If cm(i, j) > 0 Then Cells(14 + i, 2 + j) = cm(i, j)
Next
Next
End Sub
Sub hyouji1()
Dim i As Byte
For i = 0 To n * n - hnt - 1
Cells(14 + iz(i), 2 + jz(i)) = i
Next
End Sub
Private Sub CommandButton2_Click()
Rows("14:22").Select
Selection.ClearContents
Range("L4:L11").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
では、懸案のセルリスト構造解析・全体構造解析について次話で述べましょう。
