第23講 数独を解くソフトVer.1の制作
第13話 Ver.1の完成
Ver.1コード
Dim m(9, 9) As Byte, cn As Byte, onf(9, 9, 9) As Byte, ls(9, 9, 9) As Byte, lcn(9, 9) As Byte
Dim khs As Byte, yk(81) As Byte, xk(81) As Byte, tm As Byte
Private Sub CommandButton1_Click()
  hj = Timer
  tm = 0
  cn = 0
  dainyuu
  kouzoukaiseki
  'hyouji
  'zahyousakusei (0)
  'hyouji2
  f (0)
  ow = Timer
  Cells(6, 12) = "作成時間は"
  Cells(6, 13) = ow - hj
  Cells(6, 14) = "秒です。"
End Sub
Sub dainyuu()
  Dim i As Byte, j As Byte
  For i = 0 To 8
    For j = 0 To 8
      m(i, j) = Cells(3 + i, 2 + j)
    Next
  Next
  For i = 0 To 8
    For j = 0 To 8
      If m(i, j) < 1 Then
        m(i, j) = 0
      End If
    Next
  Next

End Sub
Sub kouzoukaiseki()
  Dim i As Byte, j As Byte, k As Byte, l As Byte, si As Byte, sj As Byte
  khs = 0
  For i = 0 To 8
    For j = 0 To 8
      If m(i, j) = 0 Then
        yk(khs) = i
        xk(khs) = j
        khs = khs + 1
        For k = 0 To 8
          onf(i, j, k) = 1
        Next
        For k = 0 To 8
          If m(i, k) > 0 Then onf(i, j, m(i, k) - 1) = 0
        Next
        For k = 0 To 8
          If m(k, j) > 0 Then onf(i, j, m(k, j) - 1) = 0
        Next
        si = Int(i / 3)
        sj = Int(j / 3)
        For k = 0 To 2
          For l = 0 To 2
            If 3 * si + k <> i And 3 * sj + l <> j Then If m(3 * si + k, 3 * sj + l) > 0 Then onf(i, j, m(3 * si + k, 3 * sj + l) - 1) = 0
          Next
        Next
      End If
      lcn(i, j) = 0
      For k = 0 To 8
        If onf(i, j, k) = 1 Then
          ls(i, j, lcn(i, j)) = k + 1
          lcn(i, j) = lcn(i, j) + 1
        End If
      Next
    Next
  Next
End Sub
Sub hyouji()
  Dim i As Byte, j As Byte, k As Byte
  For i = 0 To 8
    For j = 0 To 8
      If m(i, j) = 0 Then Cells(13 + i, 2 + j) = lcn(i, j)
      If m(i, j) > 0 Then Cells(13 + i, 2 + j) = "*"
    Next
  Next
End Sub
Sub zahyousakusei(g As Byte)
  Dim i As Byte, j As Byte, w As Byte, min As Byte, ik As Byte, jk As Byte, k As Byte
  min = 10
  
  For i = g To khs - 1
    If lcn(yk(i), xk(i)) < min Then
      min = lcn(yk(i), xk(i))
      ik = yk(i)
      jk = xk(i)
      k = i
    End If
  Next
  w = yk(g)
  yk(g) = ik
  yk(k) = w
  w = xk(g)
  xk(g) = jk
  xk(k) = w
  If g + 1 < khs - 1 Then
    zahyousakusei (g + 1)
    If tm = 1 Then Exit Sub
  Else
    tm = 1
    Exit Sub
  End If
End Sub
Sub hyouji2()
  Dim i As Byte, j As Byte, k As Byte
  For i = 0 To khs - 1
    Cells(13 + yk(i), 2 + xk(i)) = i
  Next
End Sub
Sub f(g As Integer)
  Dim x As Byte, y As Byte
  Dim i, j, k, zy, zx As Byte
  y = g Mod 9
  x = Int(g / 9)
  If m(y, x) > 0 Then
    If g + 1 < 81 Then
      f (g + 1)
    Else
      For j = 0 To 8
        For k = 0 To 8
          Cells(13 + j, 2 + k) = m(j, k)
        Next
      Next
      cn = cn + 1
      If cn = 1 Then Exit Sub
    End If
    Exit Sub
  End If
  Dim xs As Byte, ys As Byte, kk As Byte, kkk As Byte, ow As Byte
  ow = lcn(y, x) - 1
  xs = Int(x / 3)
  ys = Int(y / 3)
  For i = 0 To ow
    m(y, x) = ls(y, x, i)
    For j = 0 To 8
      If j <> y Then
        If m(y, x) = m(j, x) Then GoTo tobi
      End If
    Next
   
    For j = 0 To 8
      If j <> x Then
        If m(y, x) = m(y, j) Then GoTo tobi
      End If
    Next
    For j = 0 To 2
      For k = 0 To 2
        If 3 * ys + j <> y And 3 * xs + k <> x Then
          If m(y, x) = m(3 * ys + j, 3 * xs + k) Then GoTo tobi
        End If
      Next
    Next
    If g + 1 < 81 Then
      f (g + 1)
    Else
      For j = 0 To 8
        For k = 0 To 8
          Cells(13 + j, 2 + k) = m(j, k)
        Next
      Next
      cn = cn + 1
      If cn = 1 Then Exit Sub
    End If
    If cn = 1 Then Exit Sub
tobi:
  Next
  m(y, x) = 0
End Sub
Private Sub CommandButton2_Click()
  Rows("3:11").Select
  Selection.ClearContents
  Rows("13:32").Select
  Selection.ClearContents
  Cells(2, 1).Select
End Sub

ポイントは
  y = g Mod 9
  x = Int(g / 9)
要するに転置してあります。
なぜか転置(行と列を逆にする)するだけでかなり速くなるのです。

でもこれも謎です。
問題作成ソフトは、転置に関しては対称になっているはずであるからです。
今回は、不可解な点が2つも残り気持ちの悪い幕切れで申し訳ありません。
謎を解明できた方は、是非メールをしていただければと思います。

さて、次講は10進数を2進数や3進数など任意の進数に翻訳するプログラムを考えます。



第12話へ 第24講第1話へ

004
  


VBA講義第1部へ
vc++講義へ
vb講義へ
VB講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ

数学研究室に戻る