Dim hnt As Byte, iz(80) As Byte, jz(80) As Byte
Private Sub CommandButton1_Click()
CommandButton2_Click
hnt = Cells(4, 15)
retutaisyou '上下対称に配置する場合の座標作りと表示
End Sub
Sub hitaisyou() '非対称に配置する場合の座標作りと表示
Dim i As Integer, a As Integer, w As Integer, tb As Integer, h 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
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)) = "＊"
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
w = Int(36 * Rnd)
Do While 1
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(5, 15) = cn
End Sub
Private Sub CommandButton2_Click()
Range("B4:J12").Select
Selection.ClearContents
Range("L7").Select
Selection.ClearContents
Range("O5").Select
Selection.ClearContents
Cells(2, 1).Select
End Sub
参考ダウンロード添付ファイル
結構難しかったでしょう。
ですが、自然な割合で中央行にも入ってきてますね。
次の課題です。
左右対称の配置をするgyoutaisyouと
点対称配置をするtentaisyouを付け加えてください。
点対称までそろったところで、
シートからタイプを選べるようにしましょう。
