第6講 数独自動生成アプリVer.1の開発
第4話 数独自動生成と適切性の判定
数独の適切性の判定を組み込んだプログラム例
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, onoff As Byte
Private Sub CommandButton1_Click()
  CommandButton2_Click
  n = 9
  hnt = Cells(4, 15) 'ヒント数
  Dim ty As Byte
  ty = Cells(5, 15) 'タイプの取得 0:非対称 1:上下対称 2:左右対称 3:点対称
  Select Case ty 'シートのO5で指定しているタイプを選択
    Case 0
      hitaisyou '非対称座標作成
    Case 1
      retutaisyou '上下対称に生成させるための座標作成
    Case 2
      gyoutaisyou '左右対称に生成させるための座標作成
    Case 3
      tentaisyou '点対称に生成させるための座標作成
  End Select
  syokika 'm(i, j),rlst(i, j, k),cnを0に初期化、cnは生成した数独をカウントする変数
  onoff = 0 '以下2行は問題作成
  f (0)
  hyouji1 '問題の表示
  
onoff = 1 '以下3行は問題を解いている。
  cn = 0
  f (hnt)
  If cn = 1 Then '適切性の判定
    hyouji '解答の表示
    Cells(8, 12) = "適切な数独です。"
  Else
    Cells(8, 12) = "不適切な数独です。"
  End If

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 '中央の行への配置数を偶数として8個以下としている
      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 '中央行への配置数を0個以上で偶数としている
          If ch Mod 2 = 0 Then
            Exit Do
          End If
        End If
      Loop
    End If
    For i = 0 To ch - 1 '中央行への配置
      iz(i) = 4 '中央行だからy座標は4
      If i = 0 Then
        jz(i) = Int(9 * Rnd) 'x座標を0以上8以下にしている
      End If
      If i > 0 Then 'x座標が重複しないようにしている
        Do While 1
          jz(i) = Int(9 * Rnd) 'x座標を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) '中央行より上の行のy座標
      jz(i + ch) = a Mod 9 '中央行より上の行のx座標
      iz(i + ch + Int((hnt - ch) / 2)) = 8 - Int(a / 9) '中央行より下の行のy座標
      jz(i + ch + Int((hnt - ch) / 2)) = a Mod 9 '中央行より下の行のx座標
    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 '中央の行への配置数を奇数として8個以下としている
      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 '中央の行への配置数を0個以上で奇数としている
          If ch Mod 2 = 1 Then
            Exit Do
          End If
        End If
      Loop
    End If
    For i = 0 To ch - 1 '中央行への配置
      iz(i) = 4 '中央行だからy座標は4
      If i = 0 Then
        jz(i) = Int(9 * Rnd) 'x座標を0以上8以下にしている
      End If
      If i > 0 Then 'x座標が重複しないようにしている
        Do While 1
          jz(i) = Int(9 * Rnd) 'x座標を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) '中央行より上の行のy座標
      jz(i + ch) = a Mod 9 '中央行より上の行のx座標
      iz(i + ch + Int((hnt - ch) / 2)) = 8 - Int(a / 9) '中央行より下の行のy座標
      jz(i + ch + Int((hnt - ch) / 2)) = a Mod 9 '中央行より下の行のx座標
    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 '中央の列への配置数を偶数として8個以下としている
      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 '中央列への配置数を0個以上で偶数としている
          If ch Mod 2 = 0 Then
            Exit Do
          End If
        End If
      Loop
    End If
    For i = 0 To ch - 1 '中央列への配置
      jz(i) = 4 '中央列だからy座標は4
      If i = 0 Then
        iz(i) = Int(9 * Rnd) 'x座標を0以上8以下にしている
      End If
      If i > 0 Then 'x座標が重複しないようにしている
        Do While 1
          iz(i) = Int(9 * Rnd) 'x座標を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 '中央列より左の列のy座標
      jz(i + ch) = Int(a / 9) '中央列より左の列のx座標
      iz(i + ch + Int((hnt - ch) / 2)) = a Mod 9 '中央列より右の列のy座標
      jz(i + ch + Int((hnt - ch) / 2)) = 8 - Int(a / 9) '中央列より右の列のx座標
    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 '中央の列への配置数を奇数として8個以下としている
      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 '中央の列への配置数を0個以左で奇数としている
          If ch Mod 2 = 1 Then
            Exit Do
          End If
        End If
      Loop
    End If
    For i = 0 To ch - 1 '中央列への配置
      jz(i) = 4 '中央列だからy座標は4
      If i = 0 Then
        iz(i) = Int(9 * Rnd) 'x座標を0以上8以下にしている
      End If
      If i > 0 Then 'x座標が重複しないようにしている
        Do While 1
          iz(i) = Int(9 * Rnd) 'x座標を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 '中央列より左の列のy座標
      jz(i + ch) = Int(a / 9) '中央列より左の列のx座標
      iz(i + ch + Int((hnt - ch) / 2)) = a Mod 9 '中央列より右の列のy座標
      jz(i + ch + Int((hnt - ch) / 2)) = 8 - Int(a / 9) '中央列より右の列のx座標
    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以下のy座標
      jz(i) = a Mod 9 'セル番号が39以下のx座標
      iz(i + Int(hnt / 2)) = 8 - Int(a / 9) 'セル番号が39以上のy座標
      jz(i + Int(hnt / 2)) = 8 - (a Mod 9) 'セル番号が39以上のx座標
    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以下のy座標
      jz(i + 1) = a Mod 9 'セル番号が39以下のx座標
      iz(i + 1 + Int(hnt / 2)) = 8 - Int(a / 9) 'セル番号が39以上のy座標
      jz(i + 1 + Int(hnt / 2)) = 8 - (a Mod 9) 'セル番号が39以上のx座標
    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 '行に1から9までの数字がひとつずつ並んでいるかをチェック
    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 '列に1から9までの数字がひとつずつ並んでいるかをチェック
    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 'ブロックに1から9までの数字がひとつずつ並んでいるかをチェック
    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)
  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 onoff = 1 Then nyuryokujyun (g) 'onoffが1のときに入力順=新たな座標作成をしているために既存の座標が壊される。onoffが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 onoff = 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 onoff = 1 Then '問題を解く
      If g + 1 < n * n Then
        f (g + 1) '行・列・ブロックの重複がなく、g + 1がn * n以下のときに、次のセル番号の世界に飛ぶ
        If cn = 2 Then Exit Sub 'cn = 2となっている理由は別解がないか探索させるため
      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 = 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("L4:L8").Select
  Selection.ClearContents
  Cells(1, 1).Select
End Sub

参考ダウンロード添付ファイル


次の課題は、判定をして適切である場合にだけ数独と解答を表示させることです。
わざと無限ループのDo While文にして、
適切なときだけDo While文を強制的に抜けるようにするとよいと思います。
皆さん考えてください。
001
うっかり生成時間を入れ忘れましたので、
以降は入れてください。
また、試行錯誤回数もカウントして表示してください。

第3話へ 第5話へ


トップへ