Function tontb(g As Byte, ys() As Byte, t As Byte, ny As Byte) 'ブロックについての3on3解析を行うFunctionプロシージャ '引数のnyは、内容（naiyou）の略、呼び出し側のライン排除確定プロシージャのiに当たる。 'i + 1は、数独配列p(○, ○)に入力する内容（１から９の値）であった。 '確定法で解く＝仮定法を使わないので復元規定は最初から記述しない。 Dim i As Byte, j As Byte, k As Byte, l As Byte, m As Byte, o As Byte, w As Byte Dim xs1(8) As Byte 'x座標を記録する変数 Dim xs2(8) As Byte 'x座標を記録する変数 Dim ys1(8) As Byte 'x座標を記録する変数 Dim ys2(8) As Byte 'x座標を記録する変数 tontb = 1 Dim ybs As Byte, xbs As Byte ybs = rn * Int(ys(0) / rn) xbs = rn * Int(xs(0) / rn) Dim js As Byte, ja As Byte Dim ks As Byte, ka As Byte For i = ny + 1 To n_1 'i + 1 は数独配列p(○, ○)に入れる２番目の内容（１から９の値） 'もっと正確に説明すると、3on3のセルにおけるリストの２番目となる可能性のある値である。 '可能性という言い方をしたのは、以下の条件を満たしてはじめて２番目のリストになるから。 w = 0 For j = 0 To n_1 'jはブロック番号 js = Int(j / rn) ja = j Mod rn If p(ybs + js, xbs + ja) = 0 Then 's = ys(0) If kh(ybs + js, xbs + ja, i) = 1 Then ys1(w) = ybs + js xs1(w) = xbs + ja w = w + 1 End If End If Next If w = 3 Then If (ys(0) = ys1(0) Or xs(0) = xs1(0)) And (ys(1) = ys1(1) Or xs(1) = xs1(1)) And (ys(2) = ys1(2) Or xs(2) = xs1(2)) Then For j = 0 To n_1 'j + 1 は3on3セルの３番目のリスト候補 If j <> ny And j <> i Then w = 0 For k = 0 To n_1 'kはブロック内番号 ks = Int(k / rn) ka = k Mod rn If p(ybs + ks, xbs + ka) = 0 Then 's = ys(0) If kh(ybs + ks, xbs + ka, j) = 1 Then ys2(w) = ybs + ks xs2(w) = xbs + ka w = w + 1 End If End If Next If w = 2 Or w = 3 Then If (((ys2(0) = ys(0)) And (xs2(0) = xs(0))) And (((ys2(1) = ys(1)) And xs2(1) = xs(1)))) Or (((ys2(0) = ys(0)) And (xs2(0) = xs(0))) And (((ys2(2) = ys(2)) And xs2(2) = xs(2)))) Or (((ys2(1) = ys(1)) And (xs2(1) = xs(1))) And (((ys2(2) = ys(2)) And xs2(2) = xs(2)))) Then '以降3on3確定による破綻処理 For k = 0 To n_1 ks = Int(k / rn) ka = k Mod rn If (ybs + ks <> ys(0) Or xbs <> xs(0)) And (ybs + ks <> ys(1) Or xbs <> xs(1)) And (ybs + ks <> ys(2) Or xbs <> xs(2)) Then If p(ybs + ks, xbs + ka) = 0 Then If mx(ybs + ks, xbs + ka) = 2 Then w = 0 For l = 0 To 2 If rlst(ybs + ks, xbs + ka, l) = ny + 1 Or rlst(ybs + ks, xbs + ka, l) = i + 1 Or rlst(ybs + ks, xbs + ka, l) = j + 1 Then w = w + 1 End If Next If w = 3 Then tontb = 0 Exit Function End If End If If mx(ybs + ks, xbs + ka) = 1 Then w = 0 For l = 0 To 1 If rlst(ybs + ks, xbs + ka, l) = ny + 1 Or rlst(ybs + ks, xbs + ka, l) = i + 1 Or rlst(ybs + ks, xbs + ka, l) = j + 1 Then w = w + 1 End If Next If w = 2 Then tontb = 0 Exit Function End If End If If mx(ybs + ks, xbs + ka) = 0 Then If rlst(ybs + ks, xbs + ka, 0) = ny + 1 Or rlst(ybs + ks, xbs + ka, 0) = i + 1 Or rlst(ybs + ks, xbs + ka, 0) = j + 1 Then tontb = 0 Exit Function End If End If End If End If Next '3on3確定による破綻処理終了 ' Cells(4 + Int(cnt / 50), 1 + (cnt Mod 50)) = "X" ' cnt = cnt + 1 '以降3on3確定による排除解析 For k = 0 To n_1 ks = Int(k / rn) ka = k Mod rn If (ybs + ks <> ys(0) Or xbs <> xs(0)) And (ybs + ks <> ys(1) Or xbs <> xs(1)) And (ybs + ks <> ys(2) Or xbs <> xs(2)) Then If p(ybs + ks, xbs + ka) = 0 Then For l = 0 To mx(ybs + ks, xbs + ka) If ny + 1 = rlst(ybs + ks, xbs + ka, l) Then rlst(ybs + ks, xbs + ka, l) = rlst(ybs + ks, xbs + ka, mx(ybs + ks, xbs + ka)) rlst(ybs + ks, xbs + ka, mx(ybs + ks, xbs + ka)) = ny + 1 kh(ybs + ks, xbs + ka, ny) = 0 mx(ybs + ks, xbs + ka) = mx(ybs + ks, xbs + ka) - 1 Exit For End If Next For l = 0 To mx(ybs + ks, xbs + ka) If i + 1 = rlst(ybs + ks, xbs + ka, l) Then rlst(ybs + ks, xbs + ka, l) = rlst(ybs + ks, xbs + ka, mx(ybs + ks, xbs + ka)) rlst(ybs + ks, xbs + ka, mx(ybs + ks, xbs + ka)) = i + 1 kh(ybs + ks, xbs + ka, i) = 0 mx(ybs + ks, xbs + ka) = mx(ybs + ks, xbs + ka) - 1 Exit For End If Next For l = 0 To mx(ybs + ks, xbs + ka) If j + 1 = rlst(ybs + ks, xbs + ka, l) Then rlst(ybs + ks, xbs + ka, l) = rlst(ybs + ks, xbs + ka, mx(ybs + ks, xbs + ka)) rlst(ybs + ks, xbs + ka, mx(ybs + ks, xbs + ka)) = j + 1 kh(ybs + ks, xbs + ka, j) = 0 mx(ybs + ks, xbs + ka) = mx(ybs + ks, xbs + ka) - 1 Exit For End If Next End If End If Next '3on3確定による排除解析終了 '以降3on3確定解析 Dim kr(2) As Byte For k = 0 To 2 kr(k) = 0 Next w = 0 For k = 0 To mx(ys(0), xs(0)) If ny + 1 = rlst(ys(0), xs(0), k) Then kr(0) = 1 w = w + 1 Exit For End If Next For k = 0 To mx(ys(0), xs(0)) If i + 1 = rlst(ys(0), xs(0), k) Then kr(1) = 1 w = w + 1 Exit For End If Next For k = 0 To mx(ys(0), xs(0)) If j + 1 = rlst(ys(0), xs(0), k) Then kr(2) = 1 w = w + 1 Exit For End If Next If w = 3 Then rlst(ys(0), xs(0), 0) = ny + 1 rlst(ys(0), xs(0), 1) = i + 1 rlst(ys(0), xs(0), 2) = j + 1 mx(ys(0), xs(0)) = 2 End If If w = 2 Then w = 0 If kr(0) = 1 Then rlst(ys(0), xs(0), w) = ny + 1 w = w + 1 End If If kr(1) = 1 Then rlst(ys(0), xs(0), w) = i + 1 w = w + 1 End If If kr(2) = 1 Then rlst(ys(0), xs(0), w) = j + 1 w = w + 1 End If mx(ys(0), xs(0)) = 1 End If For k = 0 To 2 kr(k) = 0 Next w = 0 For k = 0 To mx(ys(1), xs(1)) If ny + 1 = rlst(ys(1), xs(1), k) Then kr(0) = 1 w = w + 1 Exit For End If Next For k = 0 To mx(ys(1), xs(1)) If i + 1 = rlst(ys(1), xs(1), k) Then kr(1) = 1 w = w + 1 Exit For End If Next For k = 0 To mx(ys(1), xs(1)) If j + 1 = rlst(ys(1), xs(1), k) Then kr(2) = 1 w = w + 1 Exit For End If Next If w = 3 Then rlst(ys(1), xs(1), 0) = ny + 1 rlst(ys(1), xs(1), 1) = i + 1 rlst(ys(1), xs(1), 2) = j + 1 mx(ys(1), xs(1)) = 2 End If If w = 2 Then w = 0 If kr(0) = 1 Then rlst(ys(1), xs(1), w) = ny + 1 w = w + 1 End If If kr(1) = 1 Then rlst(ys(1), xs(1), w) = i + 1 w = w + 1 End If If kr(2) = 1 Then rlst(ys(1), xs(1), w) = j + 1 w = w + 1 End If mx(ys(1), xs(1)) = 1 End If For k = 0 To 2 kr(k) = 0 Next w = 0 For k = 0 To mx(ys(2), xs(2)) If ny + 1 = rlst(ys(2), xs(2), k) Then kr(0) = 1 w = w + 1 Exit For End If Next For k = 0 To mx(ys(2), xs(2)) If i + 1 = rlst(ys(2), xs(2), k) Then kr(1) = 1 w = w + 1 Exit For End If Next For k = 0 To mx(ys(2), xs(2)) If j + 1 = rlst(ys(2), xs(2), k) Then kr(2) = 1 w = w + 1 Exit For End If Next If w = 3 Then rlst(ys(2), xs(2), 0) = ny + 1 rlst(ys(2), xs(2), 1) = i + 1 rlst(ys(2), xs(2), 2) = j + 1 mx(ys(2), xs(2)) = 2 End If If w = 2 Then w = 0 If kr(0) = 1 Then rlst(ys(2), xs(2), w) = ny + 1 w = w + 1 End If If kr(1) = 1 Then rlst(ys(2), xs(2), w) = i + 1 w = w + 1 End If If kr(2) = 1 Then rlst(ys(2), xs(2), w) = j + 1 w = w + 1 End If mx(ys(2), xs(2)) = 1 End If '3on3確定解析終了 Exit For End If End If End If Next End If End If Next End Function