第５話 ブロックの条件を入れる
コード例
Dim m(9, 9), cn As Integer
Private Sub CommandButton1_Click()
cn = 0
f (0)
End Sub
Sub f(g As Integer)
Dim x As Byte, y As Byte
y = Int(g / 9)
x = g Mod 9
Dim i, j, k, zy, zx As Byte
Dim cna As Integer, cns As Integer
Dim xa As Byte, ya As Byte, xs As Byte, ys As Byte
xa = x Mod 3
ya = y Mod 3
xs = Int(x / 3)
ys = Int(y / 3)
For i = 1 To 9
m(x, y) = i
If x > 0 Then
For j = 0 To x - 1
If m(x, y) = m(j, y) Then GoTo tobi
Next
End If
If y > 0 Then
For j = 0 To y - 1
If m(x, y) = m(x, j) Then GoTo tobi
Next
End If
If ya > 0 Or xa > 0 Then
For j = 0 To 2
For k = 0 To 2
If 3 * xs + j <> x And 3 * ys + k <> y Then
If m(x, y) = m(3 * xs + j, 3 * ys + k) Then GoTo tobi
End If
Next
Next
End If
If g + 1 < 81 Then
f (g + 1)
Else
cna = cn Mod 9
cns = Int(cn / 9)
z = 0
For j = 0 To 9
If j Mod 3 = 0 Then
For k = 0 To 12
Cells(7 + 14 * cns + j + zy, 1 + 14 * cna + k) = "*"
Next
zy = zy + 1
End If
If j < 9 Then
zx = 0
For k = 0 To 9
If k Mod 3 = 0 Then
Cells(7 + 14 * cns + j + zy, 1 + 14 * cna + k + zx) = "*"
zx = zx + 1
End If
If k < 9 Then Cells(7 + 14 * cns + j + zy, 1 + 14 * cna + k + zx) = m(j, k)
Next
End If
Next
cn = cn + 1
End If
tobi:
Next
m(x, y) = 0
End Sub
Private Sub CommandButton2_Click()
Cells.Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
実行例
解説
どうです。前以上の難問ですね。
だいたい
Dim xa As Byte, ya As Byte, xs As Byte, ys As Byte
xa = x Mod 3
ya = y Mod 3
xs = Int(x / 3)
ys = Int(y / 3)
ここからすでに？ではないでしょうか。
それに加えて
If ya > 0 Or xa > 0 Then
For j = 0 To 2
For k = 0 To 2
If 3 * xs + j <> x And 3 * ys + k <> y Then
If m(x, y) = m(3 * xs + j, 3 * ys + k) Then GoTo tobi
End If
Next
Next
End If
ではお手上げではないでしょうか。
上図の７は赤の部分とだけ比較すればよいのです。
（さらに正確に言うと、上の赤５，６でだけです。
7が入った時点で入力されている数字は順に９，５，６，７で３，４，１，２の欄には実際には何も入っておらず空欄です。
つまり、左図のような状態です。なぜなら、左から順に数字を入れていくようにしてありましたね。もし空欄部分はチェックしないとすると
If ya > 0 Or xa > 0 Then
For j = 0 To 2
For k = 0 To 2
If m(3 * xs + j, 3 * ys + k) > 0 Ｔhen
If 3 * xs + j <> x And 3 * ys + k <> y Then
If m(x, y) = m(3 * xs + j, 3 * ys + k) Then GoTo tobi
End If
End If
Next
Next
End If
すればよいのです。
ただ、将来数独の問題を解かせることにも挑戦します。
するとどこに数が入っているかは、問題によって違います。
それで、今回は
１と２の部分とも比較をしております。）
なぜなら同ライン上はすでに行チェック
If x > 0 Then
For j = 0 To x - 1
If m(x, y) = m(j, y) Then GoTo tobi
Next
End If
と列チェック
If y > 0 Then
For j = 0 To y - 1
If m(x, y) = m(x, j) Then GoTo tobi
Next
End If
により、重複が点検されているからです。
ですから、ブロック内の自分とは列も行も異なっているセルとだけ比較すればよいのです。
Dim xa As Byte, ya As Byte, xs As Byte, ys As Byte
xa = x Mod 3
ya = y Mod 3
xs = Int(x / 3)
ys = Int(y / 3)
と
If 3 * xs + j <> x And 3 * ys + k <> y Then
２つの部分について、その点を踏まえてもう一度お読みになってください。
m(3 * xs + j, 3 * ys + k) の座標(3 * xs + j, 3 * ys + k) は、ブロック内だけを動きます。
トレースしてみましょう。
のとき、x=6、y=7ですからxa=6 mod 3=0
ya=7 mod 3=1
xs=Int(6/3)=2
ys=Int(7/3)=2
ですから、
For j = 0 To 2
For k = 0 To 2
If 3 * xs + j <> x And 3 * ys + k <> y Then
If m(x, y) = m(3 * xs + j, 3 * ys + k) Then GoTo tobi
End If
Next
Next
のm(3 * xs + j, 3 * ys + k) は順に
m(3 * 2 + 0, 3 * 2 + 0)=m(6,6)
m(3 * 2 + 0, 3 * 2 + 1)=m(6,7)
m(3 * 2 + 0, 3 * 2 + 2)=m(6,8)
m(3 * 2 + 1, 3 * 2 + 0)=m(7,6)
m(3 * 2 + 1, 3 * 2 + 1)=m(7,7)
m(3 * 2 + 1, 3 * 2 + 2)=m(7,8)
m(3 * 2 + 2, 3 * 2 + 0)=m(8,6)
m(3 * 2 + 2, 3 * 2 + 1)=m(8,7)
m(3 * 2 + 2, 3 * 2 + 2)=m(8,8)
と動いていきます。ですが、If 3 * xs + j <> x And 3 * ys + k <> y Then
の条件すなわちIf 3 * xs + j <> 6 And 3 * ys + k <> 6 Thenに従って、
m(3 * 2 + 0, 3 * 2 + 1)=m(6,7)
m(3 * 2 + 0, 3 * 2 + 2)=m(6,8)
m(3 * 2 + 2, 3 * 2 + 1)=m(8,7)
m(3 * 2 + 2, 3 * 2 + 2)=m(8,8)
の場合のみ、すなわち
の赤のみが７と比べられているのです。
