第６話 疑似疑似数独作成ソフトの骨格
を実現するプログラム例
Dim p(8, 8) As Byte, mx(8, 8) As Byte, rlst(8, 8, 8) As Byte
'pは数独を収納する配列
'mxは各セルの候補数字の個数を収納する配列
'rlstは候補数字を収納する配列
Dim y(81) As Byte, x(81) As Byte
Dim a(8, 8) As Integer
Dim hintosu As Byte, rn As Byte
Dim cn As Integer
Private Sub CommandButton1_Click()
Rnd (-1)
Randomize Timer
CommandButton2_Click
m = Cells(1, 2)
n = Cells(2, 2)
h = Cells(3, 2)
rn = Int(Sqr(n))
hintosu = Cells(3, 7)
zlk '全体リスト構造解析プロシージャ（初期化作業も含む）
zys '座標作成プロシージャ
sds (0) '数独作成プロシージャ
If kensyou(a, n) = 1 Then
Cells(4, 2) = "すべての数字が網羅されています。"
Else
Cells(4, 2) = "一部の数字しか入っていません。"
End If
'全体リスト構造解析表示プロシージャ 正しいことが確認できた際にはこれを外す。
'全体リスト構造解析表示プロシージャを入れておくと処理にかなり時間を要する。
hyouji1
Range("A1").Select
End Sub
Sub zlk() '全体リスト構造解析プロシージャ（初期化作業も含む）
Dim i As Integer, j As Integer, k As Integer
cn = 0
For i = 0 To n - 1
For j = 0 To n - 1
mx(i, j) = n - 1
p(i, j) = 0
For k = 0 To n - 1
rlst(i, j, k) = k + 1
Next
Next
Next
End Sub
Sub zys() '座標作成プロシージャ
Dim i As Byte
Dim s As Byte, t As Byte
For i = 0 To n * n - 1
・
・
・
Next
End Sub
Sub sds(g As Integer) '数独作成プロシージャ
Dim i As Byte, ii As Byte, iii As Byte
ii = Int(Rnd * mx(y(g), x(g)))
For i = 0 To mx(y(g), x(g))
iii = (i + ii) Mod (mx(y(g), x(g)) + 1)
p(y(g), x(g)) = rlst(y(g), x(g), iii)
klk (g) '局所リスト構造解析プロシージャ
If g + 1 < hintosu Then
・
If cn = 1 Then Exit Sub
Else
hyouji '問題表示プロシージャ
cn = cn + 1
Exit Sub
End If
Next
p(y(g), x(g)) = 0
End Sub
Sub klk(g As Integer) '局所リスト構造解析プロシージャ
Dim i As Byte, j As Byte, k As Byte, w As Byte
For i = 0 To n - 1
If p(y(g), i) = 0 Then
For j = 0 To mx(y(g), i)
If p(y(g), x(g)) = rlst(y(g), i, j) Then
・
・
・
Exit For
End If
Next
End If
Next
For i = 0 To n - 1
If p(i, x(g)) = 0 Then
For j = 0 To mx(i, x(g))
If p(y(g), x(g)) = rlst(i, x(g), j) Then
・
・
・
Exit For
End If
Next
End If
Next
Dim ybs As Byte, xbs As Byte
Dim isy As Byte, ia As Byte
ybs = rn * Int(y(g) / rn)
xbs = rn * Int(x(g) / rn)
For i = 0 To n - 1
isy = Int(i / rn)
ia = i Mod rn
If ybs + isy <> y(g) And xbs + ia <> x(g) And Sp(ybs + isy, xbs + ia) = 0 Then
For j = 0 To mx(ybs + isy, xbs + ia)
If p(y(g), x(g)) = rlst(ybs + isy, xbs + ia, j) Then
・
・
・
Exit For
End If
Next
End If
Next
End Sub
Sub hyouji() '問題表示プロシージャ
Dim i As Integer
・
・
・
End Sub
'以下全体リスト構造解析表示プロシージャ 正しいことが確認できた際にもプロシージャ自体は残しておく
'この後のプログラムの進展の際に何回も利用するするから
Sub hyouji1()
Dim i As Integer, j As Integer
For i = 0 To n - 1
For j = 0 To n - 1
If p(i, j) = 0 Then
For k = 0 To n - 1
Cells(15 + i, 2 + 10 * j + k) = rlst(i, j, k)
Next
For k = 0 To mx(i, j)
'以下は、マクロの記録から学んだもの
Cells(15 + i, 2 + 10 * j + k).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'以上は、マクロの記録から学んだもの
Next
For k = mx(i, j) + 1 To n - 1
'以下は、マクロの記録から学んだもの
Cells(15 + i, 2 + 10 * j + k).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399945066682943
.PatternTintAndShade = 0
End With
'以上は、マクロの記録から学んだもの
Next
Else
For k = 0 To n - 1
Cells(15 + i, 2 + 10 * j + k) = "＊"
Next
End If
Next
Next
End Sub
Function kensyou(a() As Integer, n As Integer)
Dim b(81) As Byte, i As Integer, j As Integer
For i = 0 To n * n - 1
b(i) = 0
Next
For i = 0 To n - 1
For j = 0 To n - 1
b(a(i, j)) = 1
Next
Next
For i = 0 To n - 1
If b(i) = 0 Then
kensyou = 0
Exit Function
End If
Next
kensyou = 1
End Function
Private Sub CommandButton2_Click()
Rows("4:15").Select
Selection.ClearContents
Rows("15:35").Select
Selection.Delete
Range("A1").Select
End Sub
省略されている部分を埋めて、
疑似疑似数独作成ソフトを完成させて下さい。
ただし、第２講の最初の注意
※第２講ではヒント数を20程度にするという前提で進めます。
ヒント数が多いとエラーしますし、
たまにヒント数19辺りでもエラーすることがあります。
エラーした場合は、終了を選んで下さい。
そのトラブルの解消は、第32講で行われます。
を忘れないで下さい。
ヒント数を大きくしてしまうとエラーしてしまう場合があります。
その問題の解消は第32講の任務の１つです。
