第７話 数独自動生成アプリVer.1の完成！
数独自動生成アプリVer.1(ハイブリッド方式）のコード例
Dim n As Byte, m(8, 8) As Byte, cn As Integer, hnt As Byte, iz(80) As Byte, jz(80) As Byte, cm(8, 8) As Byte
Dim ironuri(8, 8, 8) As Byte, rlst(8, 8, 8) As Byte, mx(8, 8) As Byte, md As Byte
Dim ciz(80) As Byte, cjz(80) As Byte
Private Sub CommandButton1_Click()
CommandButton2_Click
n = 9
hnt = Cells(4, 14) 'ヒント数
Dim ty As Byte
ty = Cells(5, 14) 'タイプの取得 0:非対称 1:上下対称 2:左右対称 3:点対称
hj = Timer
Dim ks As Long '試行回数をカウントする変数
ks = 0
Do While 1
Select Case ty 'シートのO5で指定しているタイプを選択
Case 0
hitaisyou '非対称座標作成
Case 1
retutaisyou '上下対称に生成させるための座標作成
Case 2
gyoutaisyou '左右対称に生成させるための座標作成
Case 3
tentaisyou '点対称に生成させるための座標作成
End Select
If hnt < 28 Then 'ヒント数２８未満の場合
syokika 'm(i, j),rlst(i, j, k),cnを0に初期化、cnは生成した数独をカウントする変数
md = 0 'nyuryokujunで新しい座標を作成させないことと探索の範囲をhnt-1まで限定
f (0) '数独生成Subプロシージャ
md = 1 'nyuryokujunで新しい座標を作成させて、探索範囲を80までにする
cn = 0
f (hnt) '問題を解かせる
Else
cpy 'fにおいて座標が壊されてしまうので、座標を複写
md = 2 'nyuryokujunで新しい座標を作成させて、探索範囲を80までにする
cn = 0
f (0)
gcpy 'fにおいて座標が壊された座標を復元
dainyu 'fによって全体リスト構造解析が壊されているので、再代入して再度全体リスト構造解析を行う
md = 1 'nyuryokujunで新しい座標を作成させて、探索範囲を80までにする
f (hnt) '問題を解かせる
End If
ks = ks + 1 '試行回数をカウント
If cn = 1 Then '唯一解である場合
hyouji1 '問題の表示
hyouji '解答の表示
Cells(10, 15) = "適切な数独です。"
Exit Do '適切な数独が見つかったのでDo文を強制的に抜ける
End If
Loop
Cells(7, 15) = "数独生成にかかった時間は"
Cells(8, 15) = Timer - hj
Cells(9, 15) = "秒です。"
Cells(11, 15) = "試行錯誤回数は"
Cells(12, 15) = ks
Cells(13, 15) = "回です。"
End Sub
Sub cpy() 'fにおいて座標が壊されてしまうので、座標を複写
Dim i As Byte
For i = 0 To hnt - 1
ciz(i) = iz(i)
cjz(i) = jz(i)
Next
End Sub
Sub gcpy() 'fにおいて座標が壊された座標を復元
Dim i As Byte
For i = 0 To hnt - 1
iz(i) = ciz(i)
jz(i) = cjz(i)
Next
End Sub
Sub tm() '正しく配置しているかを確かめるためのプロシージャだが、実際には使っていない。削っても可。
Dim i As Byte
For i = 0 To hnt - 1
m(iz(i), jz(i)) = i + 1
Next
For i = 0 To hnt - 1
Cells(4 + iz(i), 2 + jz(i)) = m(iz(i), jz(i))
Next
Dim j As Byte, w As Byte, h As Byte
w = 0
h = 1
For i = 0 To 8
For j = 0 To 8
If Cells(4 + i, 2 + j) > 0 Then w = w + 1
If Cells(4 + i, 2 + j) > 0 Then
If Cells(12 - i, 2 + j) = 0 Then h = 0
End If
Next
Next
Cells(6, 15) = w
If h = 1 Then Cells(7, 15) = "○" Else Cells(7, 15) = "×"
End Sub
Sub hitaisyou() '非対称に生成するための座標作成
Dim i As Integer, a As Integer, w As Integer, tb As Integer, h As Byte, tane As Byte
w = Int(81 * Rnd) 'はじめの位置
tane = Int(10 * Rnd) '飛びを選択するための変数
Select Case tane '飛びの選択 tbは飛びを表す変数
Case 0
tb = 5
Case 1
tb = 7
Case 2
tb = 11
Case 3
tb = 13
Case 4
tb = 17
Case 5
tb = 19
Case 6
tb = 23
Case 7
tb = 29
Case 8
tb = 31
Case 9
tb = 37
End Select
For i = 0 To hnt - 1 '座標作成
a = (w + tb * i) Mod 81
iz(i) = Int(a / 9)
jz(i) = a Mod 9
Next
End Sub
Sub retutaisyou() '上下に生成させるための対称座標作成
Dim i As Integer, a As Integer, w As Integer, tb As Integer, h As Byte, ch As Integer, gz As Byte, j As Byte, tane As Byte
w = Int(36 * Rnd) 'はじめの位置
tane = Int(10 * Rnd) '飛びを選択するための変数
Select Case tane '飛びの選択 tbは飛びを表す変数
Case 0
tb = 5
Case 1
tb = 7
Case 2
tb = 11
Case 3
tb = 13
Case 4
tb = 17
Case 5
tb = 19
Case 6
tb = 23
Case 7
tb = 29
Case 8
tb = 31
Case 9
tb = 41
End Select
If hnt Mod 2 = 0 Then 'ヒント数が偶数の場合の座標作成
gz = Int(2 * Rnd) '中央の行に配置する「ヒント数÷9行」からの揺らぎを＋にするか－にするかの選択をする変数
If gz = 0 Then
Do While 1
ch = Int(hnt / 9) + Int(4 * Rnd) '中央の行の配置数 Int(hnt / 9)は「ヒント数÷9列」 + Int(4 * Rnd)は＋の揺らぎ
If ch Mod 2 = 0 And ch < 9 Then Exit Do '中央の行への配置数を偶数として８個以下としている
Loop
End If
If gz = 1 Then
Do While 1
ch = Int(hnt / 9) - Int(3 * Rnd) '中央の行の配置数 Int(hnt / 9)は「ヒント数÷9行」 + Int(3 * Rnd)は－の揺らぎ
If ch >= 0 Then '中央行への配置数を０個以上で偶数としている
If ch Mod 2 = 0 Then
Exit Do
End If
End If
Loop
End If
For i = 0 To ch - 1 '中央行への配置
iz(i) = 4 '中央行だからｙ座標は4
If i = 0 Then
jz(i) = Int(9 * Rnd) 'ｘ座標を0以上8以下にしている
End If
If i > 0 Then 'ｘ座標が重複しないようにしている
Do While 1
jz(i) = Int(9 * Rnd) 'ｘ座標を0以上8以下にしている
h = 1
For j = 0 To i - 1
If jz(j) = jz(i) Then
h = 0 '重複がある限りDo文を継続させる
Exit For
End If
Next
If h = 1 Then Exit Do '重複がなかったのでDo文を強制的に抜ける
Loop
End If
Next
For i = 0 To Int((hnt - ch) / 2) - 1 '中央行以外を上下対称に配置
a = (w + tb * i) Mod 36 'セル番号を35以下に限定
iz(i + ch) = Int(a / 9) '中央行より上の行のｙ座標
jz(i + ch) = a Mod 9 '中央行より上の行のｘ座標
iz(i + ch + Int((hnt - ch) / 2)) = 8 - Int(a / 9) '中央行より下の行のｙ座標
jz(i + ch + Int((hnt - ch) / 2)) = a Mod 9 '中央行より下の行のｘ座標
Next
End If
If hnt Mod 2 = 1 Then 'ヒント数が奇数の場合の座標作成
gz = Int(2 * Rnd) '中央の行に配置する「ヒント数÷9行」からの揺らぎを＋にするか－にするかの選択をする変数
If gz = 0 Then
Do While 1
ch = Int(hnt / 9) + Int(4 * Rnd) '中央の行の配置数 Int(hnt / 9)は「ヒント数÷9行」 + Int(4 * Rnd)は＋の揺らぎ
If ch Mod 2 = 1 And ch < 9 Then Exit Do '中央の行への配置数を奇数として８個以下としている
Loop
End If
If gz = 1 Then
Do While 1
ch = Int(hnt / 9) - Int(3 * Rnd) '中央の行の配置数 Int(hnt / 9)は「ヒント数÷9行」 + Int(3 * Rnd)は－の揺らぎ
If ch >= 0 Then '中央の行への配置数を０個以上で奇数としている
If ch Mod 2 = 1 Then
Exit Do
End If
End If
Loop
End If
For i = 0 To ch - 1 '中央行への配置
iz(i) = 4 '中央行だからｙ座標は4
If i = 0 Then
jz(i) = Int(9 * Rnd) 'ｘ座標を0以上8以下にしている
End If
If i > 0 Then 'ｘ座標が重複しないようにしている
Do While 1
jz(i) = Int(9 * Rnd) 'ｘ座標を0以上8以下にしている
h = 1
For j = 0 To i - 1
If jz(j) = jz(i) Then
h = 0 '重複がある限りDo文を継続させる
Exit For
End If
Next
If h = 1 Then Exit Do '重複がなかったのでDo文を強制的に抜ける
Loop
End If
Next
For i = 0 To Int((hnt - ch) / 2) - 1 '中央行以外を上下対称に配置
a = (w + tb * i) Mod 36 'セル番号を35以下に限定
iz(i + ch) = Int(a / 9) '中央行より上の行のｙ座標
jz(i + ch) = a Mod 9 '中央行より上の行のｘ座標
iz(i + ch + Int((hnt - ch) / 2)) = 8 - Int(a / 9) '中央行より下の行のｙ座標
jz(i + ch + Int((hnt - ch) / 2)) = a Mod 9 '中央行より下の行のｘ座標
Next
End If
End Sub
Sub gyoutaisyou() '左右に生成させるための対称座標作成
Dim i As Integer, a As Integer, w As Integer, tb As Integer, h As Byte, ch As Integer, gz As Byte, j As Byte, tane As Byte
w = Int(36 * Rnd) 'はじめの位置
tane = Int(10 * Rnd) '飛びを選択するための変数
Select Case tane '飛びの選択 tbは飛びを表す変数
Case 0
tb = 5
Case 1
tb = 7
Case 2
tb = 11
Case 3
tb = 13
Case 4
tb = 17
Case 5
tb = 19
Case 6
tb = 23
Case 7
tb = 29
Case 8
tb = 31
Case 9
tb = 41
End Select
If hnt Mod 2 = 0 Then 'ヒント数が偶数の場合の座標作成
gz = Int(2 * Rnd) '中央の列に配置する「ヒント数÷9列」からの揺らぎを＋にするか－にするかの選択をする変数
If gz = 0 Then
Do While 1
ch = Int(hnt / 9) + Int(4 * Rnd) '中央の列の配置数 Int(hnt / 9)は「ヒント数÷9列」 + Int(4 * Rnd)は＋の揺らぎ
If ch Mod 2 = 0 And ch < 9 Then Exit Do '中央の列への配置数を偶数として８個以下としている
Loop
End If
If gz = 1 Then
Do While 1
ch = Int(hnt / 9) - Int(3 * Rnd) '中央の列の配置数 Int(hnt / 9)は「ヒント数÷9列」 + Int(3 * Rnd)は－の揺らぎ
If ch >= 0 Then '中央列への配置数を０個以上で偶数としている
If ch Mod 2 = 0 Then
Exit Do
End If
End If
Loop
End If
For i = 0 To ch - 1 '中央列への配置
jz(i) = 4 '中央列だからｙ座標は4
If i = 0 Then
iz(i) = Int(9 * Rnd) 'ｘ座標を0以上8以下にしている
End If
If i > 0 Then 'ｘ座標が重複しないようにしている
Do While 1
iz(i) = Int(9 * Rnd) 'ｘ座標を0以上8以下にしている
h = 1
For j = 0 To i - 1
If iz(j) = iz(i) Then
h = 0 '重複がある限りDo文を継続させる
Exit For
End If
Next
If h = 1 Then Exit Do '重複がなかったのでDo文を強制的に抜ける
Loop
End If
Next
For i = 0 To Int((hnt - ch) / 2) - 1 '中央列以外を左右対称に配置
a = (w + tb * i) Mod 36 'セル番号を35以下に限定
iz(i + ch) = a Mod 9 '中央列より左の列のｙ座標
jz(i + ch) = Int(a / 9) '中央列より左の列のｘ座標
iz(i + ch + Int((hnt - ch) / 2)) = a Mod 9 '中央列より右の列のｙ座標
jz(i + ch + Int((hnt - ch) / 2)) = 8 - Int(a / 9) '中央列より右の列のｘ座標
Next
End If
If hnt Mod 2 = 1 Then 'ヒント数が奇数の場合の座標作成
gz = Int(2 * Rnd) '中央の列に配置する「ヒント数÷9列」からの揺らぎを＋にするか－にするかの選択をする変数
If gz = 0 Then
Do While 1
ch = Int(hnt / 9) + Int(4 * Rnd) '中央の列の配置数 Int(hnt / 9)は「ヒント数÷9列」 + Int(4 * Rnd)は＋の揺らぎ
If ch Mod 2 = 1 And ch < 9 Then Exit Do '中央の列への配置数を奇数として８個以下としている
Loop
End If
If gz = 1 Then
Do While 1
ch = Int(hnt / 9) - Int(3 * Rnd) '中央の列の配置数 Int(hnt / 9)は「ヒント数÷9列」 + Int(3 * Rnd)は－の揺らぎ
If ch >= 0 Then '中央の列への配置数を０個以左で奇数としている
If ch Mod 2 = 1 Then
Exit Do
End If
End If
Loop
End If
For i = 0 To ch - 1 '中央列への配置
jz(i) = 4 '中央列だからｙ座標は4
If i = 0 Then
iz(i) = Int(9 * Rnd) 'ｘ座標を0以上8以下にしている
End If
If i > 0 Then 'ｘ座標が重複しないようにしている
Do While 1
iz(i) = Int(9 * Rnd) 'ｘ座標を0以上8以下にしている
h = 1
For j = 0 To i - 1
If iz(j) = iz(i) Then
h = 0 '重複がある限りDo文を継続させる
Exit For
End If
Next
If h = 1 Then Exit Do '重複がなかったのでDo文を強制的に抜ける
Loop
End If
Next
For i = 0 To Int((hnt - ch) / 2) - 1 '中央列以外を左右対称に配置
a = (w + tb * i) Mod 36 'セル番号を35以下に限定
iz(i + ch) = a Mod 9 '中央列より左の列のｙ座標
jz(i + ch) = Int(a / 9) '中央列より左の列のｘ座標
iz(i + ch + Int((hnt - ch) / 2)) = a Mod 9 '中央列より右の列のｙ座標
jz(i + ch + Int((hnt - ch) / 2)) = 8 - Int(a / 9) '中央列より右の列のｘ座標
Next
End If
End Sub
Sub tentaisyou() '点対称に生成させるための座標作成
Dim i As Integer, a As Integer, w As Integer, tb As Integer, h As Byte, tane As Byte
w = Int(40 * Rnd) 'はじめの位置
tane = Int(10 * Rnd) '飛びを選択するための変数
Select Case tane '飛びの選択 tbは飛びを表す変数
Case 0
tb = 7
Case 1
tb = 11
Case 2
tb = 13
Case 3
tb = 17
Case 4
tb = 19
Case 5
tb = 23
Case 6
tb = 29
Case 7
tb = 47
Case 8
tb = 59
Case 9
tb = 61
End Select
If hnt Mod 2 = 0 Then 'ヒント数が偶数の場合の座標作成
For i = 0 To Int(hnt / 2) - 1
a = (w + tb * i) Mod 40 'セル番号を39以下に限定
iz(i) = Int(a / 9) 'セル番号が39以下のｙ座標
jz(i) = a Mod 9 'セル番号が39以下のｘ座標
iz(i + Int(hnt / 2)) = 8 - Int(a / 9) 'セル番号が39以上のｙ座標
jz(i + Int(hnt / 2)) = 8 - (a Mod 9) 'セル番号が39以上のｘ座標
Next
End If
If hnt Mod 2 = 1 Then 'ヒント数が偶数の場合の座標作成
iz(0) = 4
jz(0) = 4
For i = 0 To Int(hnt / 2) - 1
a = (w + tb * i) Mod 40 'セル番号を39以下に限定
iz(i + 1) = Int(a / 9) 'セル番号が39以下のｙ座標
jz(i + 1) = a Mod 9 'セル番号が39以下のｘ座標
iz(i + 1 + Int(hnt / 2)) = 8 - Int(a / 9) 'セル番号が39以上のｙ座標
jz(i + 1 + Int(hnt / 2)) = 8 - (a Mod 9) 'セル番号が39以上のｘ座標
Next
End If
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 syokika() '初期化
Dim i As Byte, j As Byte, k As Byte
For i = 0 To n - 1
For j = 0 To n - 1
m(i, j) = 0
mx(i, j) = 9
For k = 0 To n - 1
ironuri(i, j, k) = 0
Next
Next
Next
cn = 0
End Sub
Sub dainyu() '代入と全体リスト構造解析
Dim i As Byte, j As Byte, k As Byte, y As Byte, x As Byte
For i = 0 To n - 1
For j = 0 To n - 1
m(i, j) = 0
For k = 0 To n - 1
ironuri(i, j, k) = 0
Next
Next
Next
For i = 0 To hnt - 1
m(iz(i), jz(i)) = cm(iz(i), jz(i))
For j = 0 To n - 1
If m(iz(i), j) = 0 Then
ironuri(iz(i), j, m(iz(i), jz(i)) - 1) = 1
End If
If m(j, jz(i)) = 0 Then
ironuri(j, jz(i), m(iz(i), jz(i)) - 1) = 1
End If
y = 3 * Int(iz(i) / 3) + Int(j / 3)
x = 3 * Int(jz(i) / 3) + (j Mod 3)
If y <> iz(i) And x <> jz(i) Then
If m(y, x) = 0 Then
ironuri(y, x, m(iz(i), jz(i)) - 1) = 1
End If
End If
Next
Next
For i = 0 To n - 1
For j = 0 To n - 1
If m(i, j) = 0 Then
kyokusyokaiseki i, j
End If
Next
Next
cn = 0
End Sub
Sub kyokusyokaiseki(y As Byte, x As Byte) 'セルリスト構造解析、1つのセルの解析なので局所解析としている
Dim i As Byte, w As Byte
w = 0
For i = 0 To n - 1
If ironuri(y, x, i) = 0 Then
rlst(y, x, w) = i + 1
w = w + 1
End If
Next
mx(y, x) = w
End Sub
Sub nyuryokujyun(g As Byte) '入力順の決定 効率的に数独が作成できるように座標を作り直している
Dim i As Byte, j As Byte, mn As Byte, ik As Byte, jk As Byte
mn = 100
For i = 0 To 8
For j = 0 To 8
If m(i, j) = 0 Then
If mx(i, j) < mn Then
mn = mx(i, j)
ik = i
jk = j
End If
End If
Next
Next
iz(g) = ik
jz(g) = jk
End Sub
Sub f(g As Byte) '数独作成Subプロシージャ
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, ii As Byte, iii As Byte
Dim hg(8) As Byte, hr(8) As Byte, hb(8) As Byte
If md > 0 Then nyuryokujyun (g) 'mdが1または2のときに入力順＝新たな座標作成をしているために既存の座標が壊される。mdが0ときは既存の座標を壊さない
y = iz(g)
x = jz(g)
kyokusyokaiseki y, x '現在のセルのリスト構造解析
If mx(y, x) = 0 Then Exit Sub '破綻した場合の処理、破綻した場合過去の入れ方が悪いので過去に戻ってやり直す。
ii = Int(mx(y, x) * Rnd)
For i = 0 To mx(y, x) - 1 'セルの候補数字のみを対象にする
iii = (i + ii) Mod mx(y, x)
m(y, x) = rlst(y, x, iii) '順番に入れるのではなくランダムに入れることによって、規則的でなくする。
For j = 0 To n - 1
hg(j) = 0
hr(j) = 0
hb(j) = 0
Next
For j = 0 To n - 1 '以下色塗り。mx(y, x)の行と列とブロックにmx(y, x)に入力された数字を入れることを不可とする。
If m(y, j) = 0 Then
If ironuri(y, j, m(y, x) - 1) = 0 Then
ironuri(y, j, m(y, x) - 1) = 1 'm(y, x)の入力によって影響を受けた行のセルの色塗り
hg(j) = 1 '行における色塗りの場所を記録
End If
End If
If m(j, x) = 0 Then
If ironuri(j, x, m(y, x) - 1) = 0 Then
ironuri(j, x, m(y, x) - 1) = 1 ' 'm(y, x)の入力によって影響を受けた列のセルの色塗り
hr(j) = 1 '列における色塗りの場所を記録
End If
End If
yy = 3 * Int(y / 3) + Int(j / 3)
xx = 3 * Int(x / 3) + (j Mod 3)
If yy <> y And xx <> x Then
If m(yy, xx) = 0 Then
If ironuri(yy, xx, m(y, x) - 1) = 0 Then
ironuri(yy, xx, m(y, x) - 1) = 1 'm(y, x)の入力によって影響を受けたブロックのセルの色塗り
hb(j) = 1 'ブロックにおける色塗りの場所を記録
End If
End If
End If
Next
If md = 0 Then '問題作成
If g + 1 < hnt Then
f (g + 1) '行・列・ブロックの重複がなく、g + 1がhnt以下のときに、次のセル番号の世界に飛ぶ
If cn = 1 Then Exit Sub 'cn = 1となっている理由は問題が1つ出来ればよいから
Else
cn = cn + 1
If cn = 1 Then Exit Sub 'cn = 1となっている理由は問題が1つ出来ればよいから
End If
End If
If md = 2 Then '解答から問題を作るために解答を作成
If g + 1 < n * n Then
f (g + 1) '行・列・ブロックの重複がなく、g + 1がn * n 以下のときに、次のセル番号の世界に飛ぶ
If cn = 1 Then Exit Sub 'cn = 1となっている理由は解答が1つ出来ればよいから
Else
cn = cn + 1
If cn = 1 Then
For j = 0 To n - 1
For k = 0 To n - 1
cm(j, k) = m(j, k)
Next
Next
End If
If cn = 1 Then Exit Sub 'cn = 1となっている理由は問題が1つ出来ればよいから
End If
End If
If md = 1 Then '問題を解く
If g + 1 < n * n Then
f (g + 1)
If cn = 2 Then Exit Sub 'cn = 2となっている理由は別解がないか探索させるため
Else
cn = cn + 1
If cn = 1 Then
For j = 0 To n - 1 '別解がないか探索させている間にm(i ,j)は壊されてしまうためにバックアップをとっている。
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
For j = 0 To n - 1
If hg(j) = 1 Then
ironuri(y, j, m(y, x) - 1) = 0 'mx(y, x)に数字を入れ直すので、行の該当箇所を色なしに復元
End If
If hr(j) = 1 Then
ironuri(j, x, m(y, x) - 1) = 0 'mx(y, x)に数字を入れ直すので、列の該当箇所を色なしに復元
End If
If hb(j) = 1 Then
yy = 3 * Int(y / 3) + Int(j / 3)
xx = 3 * Int(x / 3) + (j Mod 3)
ironuri(yy, xx, m(y, x) - 1) = 0 'mx(y, x)に数字を入れ直すので、ブロックの該当箇所を色なしに復元
End If
Next
Next
m(y, x) = 0 'すべての場合を尽くしてやり直して過去に戻るので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 hnt - 1
Cells(4 + iz(i), 2 + jz(i)) = m(iz(i), jz(i))
Next
End Sub
Private Sub CommandButton2_Click()
Range("B4:J12").Select
Selection.ClearContents
Range("B14:J22").Select
Selection.ClearContents
Range("L6:Q20").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
※ 注釈文を入れないで講義を進めてしまい、
後から入れるのは本当に大変な作業でしたが、
第６講第７話のダウンロード添付ファイルにおいてはじめて注釈文を納得のいく形で入れることが出来ました。
まだ、第６講第７話以前には注釈文が入っていない添付ファイルもありますが、
半分以上のファイルには注釈文を入れてきています。
残っている添付ファイルにも少しずつ入れていきますし、
以後の講義では、必ず注釈文を入れていきます。
注釈文がなかったために、
わかりにくい部分があったことについてお詫びを申し上げます。
尚、今回の失敗を活かし新に始める
「数独自動生成アプリを題材とする初心者のためのVBA入門講義」
では最初から注釈文を入れていきますので、
私の怠慢をお許しいただければと思います。
ハイブリッドにしたら、ヒント数が多いときにはあっという間に出来るようになりましたね。
そして、試行錯誤回数もほぼ1回になります。
ヒント数が少ない場合に生成に時間がかかります。
逆に、すべて
①．問題を解く
②．解答から問題を作成する
③．再度問題を解く
に統一したら、時間がかかりすぎるという問題は解決するでしょうか。
もし、そうならハイブリッド方式は必要がなかったことになります。
皆さん、実験してみましょう。
