Dim hnt As Byte, iz(80) As Byte, jz(80) As Byte
Private Sub CommandButton1_Click()
CommandButton2_Click
hnt = Cells(4, 15)
ty = Cells(5, 15)
Select Case ty
Case 0
hitaisyou
Case 1
retutaisyou
Case 2
gyoutaisyou
Case 3
tentaisyou
End Select
End Sub
Sub hitaisyou() '非対称に配置する場合の座標作りと表示
Dim i As Integer, a As Integer, w As Integer, tb As Integer, h As Byte, cn As Byte
w = Int(81 * Rnd) 'はじめの位置をランダムに取得
Do While 1 '81と互いに素になるtbを自動的に探す。
tb = Int(36 * Rnd)
h = 1
For i = 2 To tb
If i * i > tb Then Exit For
If (81 Mod i) = 0 Then
If (tb Mod i) = 0 Then
h = 0
Exit For
End If
End If
Next
If h = 1 Then Exit Do
Loop
cn = 0
For i = 0 To hnt - 1
a = (w + tb * i) Mod 81 'aはセル(箱)番号を表す変数
iz(i) = Int(a / 9)
jz(i) = a Mod 9
Cells(4 + iz(i), 2 + jz(i)) = "＊"
cn = cn + 1
Next
Cells(6, 15) = cn
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
w = Int(36 * Rnd)
Do While 1 '36と互いに素になるtbを自動で探している。
tb = 2 + Int(34 * Rnd)
h = 1
For i = 2 To tb
If i * i > tb Then Exit For
If (36 Mod i) = 0 Then
If (tb Mod i) = 0 Then
h = 0
Exit For
End If
End If
Next
If h = 1 Then Exit Do
Loop
Dim cn As Byte
cn = 0
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
Cells(4 + iz(i), 2 + jz(i)) = "＊"
cn = cn + 1
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 '中央行より下の行のｘ座標
Cells(4 + iz(i + ch), 2 + jz(i + ch)) = "＊"
Cells(4 + iz(i + ch + Int((hnt - ch) / 2)), 2 + jz(i + ch + Int((hnt - ch) / 2))) = "＊"
cn = cn + 2
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
Cells(4 + iz(i), 2 + jz(i)) = "＊"
cn = cn + 1
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 '中央行より下の行のｘ座標
Cells(4 + iz(i + ch), 2 + jz(i + ch)) = "＊"
Cells(4 + iz(i + ch + Int((hnt - ch) / 2)), 2 + jz(i + ch + Int((hnt - ch) / 2))) = "＊"
cn = cn + 2
Next
End If
Cells(6, 15) = cn
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
w = Int(36 * Rnd)
Do While 1 '36と互いに素になるtbを自動で探している。
tb = 2 + Int(34 * Rnd)
h = 1
For i = 2 To tb
If i * i > tb Then Exit For
If (36 Mod i) = 0 Then
If (tb Mod i) = 0 Then
h = 0
Exit For
End If
End If
Next
If h = 1 Then Exit Do
Loop
Dim cn As Byte
cn = 0
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
Cells(4 + iz(i), 2 + jz(i)) = "＊"
cn = cn + 1
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) '中央列より右の列のｘ座標
Cells(4 + iz(i + ch), 2 + jz(i + ch)) = "＊"
Cells(4 + iz(i + ch + Int((hnt - ch) / 2)), 2 + jz(i + ch + Int((hnt - ch) / 2))) = "＊"
cn = cn + 2
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
Cells(4 + iz(i), 2 + jz(i)) = "＊"
cn = cn + 1
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) '中央列より右の列のｘ座標
Cells(4 + iz(i + ch), 2 + jz(i + ch)) = "＊"
Cells(4 + iz(i + ch + Int((hnt - ch) / 2)), 2 + jz(i + ch + Int((hnt - ch) / 2))) = "＊"
cn = cn + 2
Next
End If
Cells(6, 15) = cn
End Sub
Sub tentaisyou()
Dim i As Integer, a As Integer, w As Integer, tb As Integer, h As Byte
Do While 1 '40 と互いに素になるtbを自動で探している。
tb = 2 + Int(36 * Rnd)
h = 1
For i = 2 To tb
If i * i > tb Then Exit For
If (40 Mod i) = 0 Then
If (tb Mod i) = 0 Then
h = 0
Exit For
End If
End If
Next
If h = 1 Then Exit Do
Loop
Dim cn As Byte
cn = 0
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以上のｘ座標
Cells(4 + iz(i), 2 + jz(i)) = "＊"
Cells(4 + iz(i + Int(hnt / 2)), 2 + jz(i + Int(hnt / 2))) = "＊"
cn = cn + 1
Next
End If
If hnt Mod 2 = 1 Then 'ヒント数が奇数の場合の座標作成
iz(0) = 4
jz(0) = 4
Cells(4 + iz(0), 2 + jz(0)) = "＊"
cn = cn + 1
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以上のｘ座標
Cells(4 + iz(i + 1), 2 + jz(i + 1)) = "＊"
Cells(4 + iz(i + 1 + Int(hnt / 2)), 2 + jz(i + 1 + Int(hnt / 2))) = "＊"
cn = cn + 1
Next
End If
Cells(6, 15) = cn
End Sub
Private Sub CommandButton2_Click()
Range("B4:J12").Select
Selection.ClearContents
Range("L7").Select
Selection.ClearContents
Range("O6").Select
Selection.ClearContents
Cells(2, 1).Select
End Sub
参考ダウンロード添付ファイル
※残念ながら
のように＊が対角線上に並ぶときには、
＊が正しくカウントされません。
いろいろ研究しましたが、この問題の解決策は見つかりませんでした。
ですが、第６講第３話においてこの問題は別の方法でクリアします。
上のコードのどこに問題があるのか、
わかった方は、大変お手数で申し訳ないのですが、
是非メールで教えていただければと思います。
さて、ナンプレ自動生成ソフト開発の準備が整いましたので、
数独自動生成アプリの開発に入りましょう。
＊ではなく数字を配置するには、
第４講で開発した数独を解くソフトVer.3 添付ファイルを改良します。
問題作成段階でも行・列・ブロックのいずれでも数字を重複させないためです。
dainyuは後で使いますので、削除せずに
Private Sub CommandButton1_Click()
CommandButton2_Click
n = 9
Randomize (Timer)
hj = Timer
' dainyu
syokika
f (0) 'ｎ次順列作成プロシージャ
ow = Timer
・
・
注釈文にして、
代わりにsyokikaを入れてください。
syokikaの任務はdainyuの最初にやっていた仕事と同じで、
m(i, j)とrlst(i, j, k)とcnを0に初期化することです。
さらに、mx(i, j)をすべて9に初期化しておきましょう。
この初期化がないと
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
Dim hg(8) As Byte, hr(8) As Byte, hb(8) As Byte
nyuryokujyun (g)
・
・
・
nyuryokujyun (g)が機能しません。
Subプロシージャfを改良して、
ヒント数０数独を作成させ、
１個生成したら止めて表示するようにしてください。
