第８講 数独（ナンプレ）作成アプリVer.3に３on３確定と排除を組み込む
第８話 行の３on３解析を行うFunctionプロシージャコード例
Function tontx(g As Byte, xs() As Byte, s 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座標を記録する変数
tontx = 1
For i = ny + 1 To n_1
'i + 1 は数独配列p(○, ○)に入れる２番目の内容（１から９の値）
'もっと正確に説明すると、3on3のセルにおけるリストの２番目となる可能性のある値である。
'可能性という言い方をしたのは、以下の条件を満たしてはじめて２番目のリストになるから。
w = 0
For j = 0 To n_1 'jはx座標(横座標）
If p(s, j) = 0 Then 's = ys(0)
If kh(s, j, i) = 1 Then
xs1(w) = j
w = w + 1
End If
End If
Next
If w = 3 Then
If xs(0) = xs1(0) And xs(1) = xs1(1) And 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はx座標(横座標）
If p(s, k) = 0 Then 's = ys(0)
If kh(s, k, j) = 1 Then
xs2(w) = k
w = w + 1
End If
End If
Next
If w = 2 Or w = 3 Then
If (xs2(0) = xs(0) And xs2(1) = xs(1)) Or (xs2(0) = xs(0) And xs2(2) = xs(2)) Or (xs2(1) = xs(1) And xs2(2) = xs(2)) Then
'以降3on3確定による破綻処理
For k = 0 To n_1
If k <> xs(0) And k <> xs(1) And k <> xs(2) Then
If p(s, k) = 0 Then
If mx(s, k) = 2 Then
w = 0
For l = 0 To 2
If rlst(s, k, l) = ny + 1 Or rlst(s, k, l) = i + 1 Or rlst(s, k, l) = j + 1 Then
w = w + 1
End If
Next
If w = 3 Then
tontx = 0
Exit Function
End If
End If
If mx(s, k) = 1 Then
w = 0
For l = 0 To 1
If rlst(s, k, l) = ny + 1 Or rlst(s, k, l) = i + 1 Or rlst(s, k, l) = j + 1 Then
w = w + 1
End If
Next
If w = 2 Then
tontx = 0
Exit Function
End If
End If
If mx(s, k) = 0 Then
If rlst(s, k, 0) = ny + 1 Or rlst(s, k, 0) = i + 1 Or rlst(s, k, 0) = j + 1 Then
tontx = 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
If k <> xs(0) And k <> xs(1) And k <> xs(2) Then
If p(s, k) = 0 Then
For l = 0 To mx(s, k)
If ny + 1 = rlst(s, k, l) Then
rlst(s, k, l) = rlst(s, k, mx(s, k))
rlst(s, k, mx(s, k)) = ny + 1
kh(s, k, ny) = 0
mx(s, k) = mx(s, k) - 1
Exit For
End If
Next
For l = 0 To mx(s, k)
If i + 1 = rlst(s, k, l) Then
rlst(s, k, l) = rlst(s, k, mx(s, k))
rlst(s, k, mx(s, k)) = i + 1
kh(s, k, i) = 0
mx(s, k) = mx(s, k) - 1
Exit For
End If
Next
For l = 0 To mx(s, k)
If j + 1 = rlst(s, k, l) Then
rlst(s, k, l) = rlst(s, k, mx(s, k))
rlst(s, k, mx(s, k)) = j + 1
kh(s, k, j) = 0
mx(s, k) = mx(s, k) - 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(s, xs(0))
If ny + 1 = rlst(s, xs(0), k) Then
kr(0) = 1
w = w + 1
Exit For
End If
Next
For k = 0 To mx(s, xs(0))
If i + 1 = rlst(s, xs(0), k) Then
kr(1) = 1
w = w + 1
Exit For
End If
Next
For k = 0 To mx(s, xs(0))
If j + 1 = rlst(s, xs(0), k) Then
kr(2) = 1
w = w + 1
Exit For
End If
Next
If w = 3 Then
rlst(s, xs(0), 0) = ny + 1
rlst(s, xs(0), 1) = i + 1
rlst(s, xs(0), 2) = j + 1
mx(s, xs(0)) = 2
End If
If w = 2 Then
w = 0
If kr(0) = 1 Then
rlst(s, xs(0), w) = ny + 1
w = w + 1
End If
If kr(1) = 1 Then
rlst(s, xs(0), w) = i + 1
w = w + 1
End If
If kr(2) = 1 Then
rlst(s, xs(0), w) = j + 1
w = w + 1
End If
mx(s, xs(0)) = 1
End If
For k = 0 To 2
kr(k) = 0
Next
w = 0
For k = 0 To mx(s, xs(1))
If ny + 1 = rlst(s, xs(1), k) Then
kr(0) = 1
w = w + 1
Exit For
End If
Next
For k = 0 To mx(s, xs(1))
If i + 1 = rlst(s, xs(1), k) Then
kr(1) = 1
w = w + 1
Exit For
End If
Next
For k = 0 To mx(s, xs(1))
If j + 1 = rlst(s, xs(1), k) Then
kr(2) = 1
w = w + 1
Exit For
End If
Next
If w = 3 Then
rlst(s, xs(1), 0) = ny + 1
rlst(s, xs(1), 1) = i + 1
rlst(s, xs(1), 2) = j + 1
mx(s, xs(1)) = 2
End If
If w = 2 Then
w = 0
If kr(0) = 1 Then
rlst(s, xs(1), w) = ny + 1
w = w + 1
End If
If kr(1) = 1 Then
rlst(s, xs(1), w) = i + 1
w = w + 1
End If
If kr(2) = 1 Then
rlst(s, xs(1), w) = j + 1
w = w + 1
End If
mx(s, xs(1)) = 1
End If
For k = 0 To 2
kr(k) = 0
Next
w = 0
For k = 0 To mx(s, xs(2))
If ny + 1 = rlst(s, xs(2), k) Then
kr(0) = 1
w = w + 1
Exit For
End If
Next
For k = 0 To mx(s, xs(2))
If i + 1 = rlst(s, xs(2), k) Then
kr(1) = 1
w = w + 1
Exit For
End If
Next
For k = 0 To mx(s, xs(2))
If j + 1 = rlst(s, xs(2), k) Then
kr(2) = 1
w = w + 1
Exit For
End If
Next
If w = 3 Then
rlst(s, xs(2), 0) = ny + 1
rlst(s, xs(2), 1) = i + 1
rlst(s, xs(2), 2) = j + 1
mx(s, xs(2)) = 2
End If
If w = 2 Then
w = 0
If kr(0) = 1 Then
rlst(s, xs(2), w) = ny + 1
w = w + 1
End If
If kr(1) = 1 Then
rlst(s, xs(2), w) = i + 1
w = w + 1
End If
If kr(2) = 1 Then
rlst(s, xs(2), w) = j + 1
w = w + 1
End If
mx(s, xs(2)) = 1
End If
'3on3確定解析終了
Exit For
End If
End If
End If
Next
End If
End If
Next
End Function
テキスト形式の添付ファイル
面倒な場合には添付ファイルをコピペして使って下さい。
自分でタイプしなければプログラミングが上達しないなどの考えは、
迷信です。
大事なことは理解することです。
もっともVBAの場合には、添付ファイルを使わずに、
このページを直接コピペしても問題を起こさないようにはなっています。
全角スペースを挿入してもエラーしない設計になっているからです。
他の言語もこの点は是非とも学んで頂きたいと思います。
VBやVBAを小馬鹿にする方もいらっしゃいますが、
私は、JavaよりVBAを高く評価しています。
エクセルやワードと直結していて、
高度なアプリが誰にでも簡単に作れるからです。
もっとも好きな言語を挙げなさいといわれれば、
迷わずC++とVBAを挙げます。
さて、次は列の３on３解析を行うFunctionプロシージャ
のコーティングです。
皆さん、頑張りましょう。
tontxのコードをコピペして、
編集の置換において、
カレント プロシージャ内で「すべて置換」するを使って効率的に、
コーティングしてください。
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入門へ
本サイトトップへ
