第８講 数独（ナンプレ）作成アプリVer.3に３on３確定と排除を組み込む
第10話 ブロックの３on３解析を行うFunctionプロシージャコード例
Function tontb(g As Byte, ys() As Byte, xs() 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
テキスト形式の添付ファイル
eclipse c++ 入門
魔方陣 数独（ナンプレ）で学ぶ VBA 入門
数独（ナンプレ）のシンプルな解き方・簡単な解法の研究
vc++講義へ
excel 2013 2010 2007 vba入門へ
ＶＢ講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
専門用語なしの C言語 C++ 入門（Visual C++ 2010で学ぶ C言語 C++ 入門）
専門用語なしの excel vba マクロ 入門 2013 2010 2007 対応講義 第1部
eclipse java 入門へ
excel 2016 vba 入門へ
小学生からエンジニアまでのRuby入門へ
本サイトトップへ
