Excel将棋：終局（詰み）判定と打ち歩詰め(№16)
Excelで将棋を作ってみましょう。
人vs人で動かしてゲームとして成立するところまでが当面の目標です。
打ち歩詰めを判定するには、そもそも「詰み」の判定が必要です。
つまり、「詰み」の判定を先に入れて、歩を打った時点で「詰み」になる場合は「打ち歩詰め」と判定して着手できないようにします。
反則（禁じ手）
1.二手指し
2.動けないところに駒を進める：自動で成る
3.二歩
4.身動きの取れない駒を打つ：先手は1段目に歩を打てない
5.王手放置
2.動けないところに駒を進める：自動で成る
3.二歩
4.身動きの取れない駒を打つ：先手は1段目に歩を打てない
5.王手放置
前回、Excel将棋：反則（禁じ手）判定 こちらで実装済み。
・反則（禁じ手） ・Excel将棋の動作 ・各クラスの共通で持つプロパティを整理 ・VBAの修正箇所について ・Excel将棋のダウンロード ・Excel将棋の目次
ただし、盤面を戻した場合に不具合があったので、今回修正しました。6.打ち歩詰め
先に詰み判定が必要
詰み判定が完成した後に実装を考える。
詰み判定が完成した後に実装を考える。
7.連続王手の千日手
先に千日手の判定が必要
千日手の判定が完成した後に実装を考える。
次回、なんとか実装を考えます。
千日手の判定が完成した後に実装を考える。
次回、なんとか実装を考えます。
Excel将棋の動作
現時点の動作です。
二歩
身動きの取れない駒を打つ：先手は1段目に歩を打てない
王手放置
動けないところに駒を進める：自動で成る
打ち歩詰め
VBAの追加・修正箇所について
以下では、詰みと打ち歩詰めの実装に伴って変更・追加したプロシージャーのみを掲載します。
着手の最後に千日手と連続王手の千日手の判定を入れました。
Private Sub 着手(ByVal arg元選択 As Range, _
ByVal arg先選択 As Range, _
Optional ByVal arg成 As Variant, _
Optional ByVal arg時間1手 As Date, _
Optional ByVal arg時間累計 As Date)
'着手してシートを更新
Dim tmp駒台 As cls駒台
Set tmp駒台 = IIf(Me.先手, obj先手駒台, obj後手駒台)
If arg先選択.Value <> "" Then
'駒台へ
Call tmp駒台.駒追加(obj将棋盤.駒(セル2位置(arg先選択)))
'盤から削除
Call obj将棋盤.着手(arg先選択.Value, セル2位置(arg先選択), g位置(0, 0), _
Me.先手, arg成, arg時間1手, arg時間累計)
End If
If 選択場所(arg元選択) = e場所.将棋盤 Then
'盤上で駒移動
Call obj将棋盤.着手(arg元選択.Value, セル2位置(arg元選択), セル2位置(arg先選択), _
Me.先手, arg成, arg時間1手, arg時間累計)
Else
'盤上へ駒を打つ
Call obj将棋盤.着手(arg元選択.Value, g位置(0, 0), セル2位置(arg先選択), _
Me.先手, arg成, arg時間1手, arg時間累計)
'駒台から削除
Call tmp駒台.駒削除(arg元選択.Value)
End If
'駒台の履歴作成
Call obj先手駒台.履歴追加
Call obj後手駒台.履歴追加
'シートの表示
Call 盤面表示
Call 選択セルを手番に移動
Call frm棋譜.棋譜表示(obj将棋盤.棋譜履歴, obj将棋盤.開始時刻, obj将棋盤.最終時刻)
'各種オブジェクトの手数を進める
Me.手数 = Me.手数 + 1
'自動実行時は詰みや千日手は確認不要
If RunAuto Then Exit Sub
'詰んでいたら終局
If 詰み(obj将棋盤.駒配列, Me.先手) Then
Call obj将棋盤.棋譜終局追加("詰み")
Call frm棋譜.棋譜表示(obj将棋盤.棋譜履歴, obj将棋盤.開始時刻, obj将棋盤.最終時刻)
MsgBox "アタタタタタタタ！！" & vbLf & vbLf & _
"お前はもう詰んでいる" & vbLf & vbLf & _
IIf(Me.先手, "後手", "先手") & "の勝ちです。"
End If
End Sub
着手の最後、つまり実際に着手されて局面が進んだ後に詰みの判定を行っています。
詰みと打ち歩詰めの実装で新規に作成したプロシージャー
'**********************************************************************
' 詰みの判定
'**********************************************************************
Private Function 詰み(ByRef arg駒配列() As cls駒, _
ByVal arg先手) As Boolean
詰み = False
If RunAuto Then Exit Function
If Not 王手(arg駒配列, arg先手) Then Exit Function
'盤上のどの駒をどこに動かしても王手のまま
If 詰み駒移動回避(arg駒配列, arg先手) Then
Exit Function '詰み回避可能
End If
'持駒のどの駒をどこに打っても王手のまま
If 詰み駒打ち回避(arg駒配列, arg先手) Then
Exit Function '詰み回避可能
End If
詰み = True
End Function
Private Function 詰み駒移動回避(ByRef arg駒配列() As cls駒, _
ByVal arg先手) As Boolean
詰み駒移動回避 = True 'Trueが詰み回避可能
Dim ary次局面() As cls駒
Dim tmp次位置 As g位置
Dim i As Long, j As Long
'盤上のどの駒をどこに動かしても王手のまま
For i = 1 To 9: For j = 1 To 9
If CompProperty(arg駒配列(i, j), "先手", arg先手) Then
For Each tmp次位置 In arg駒配列(i, j).駒移動可能位置(arg駒配列)
ary次局面 = 着手後盤面(arg駒配列, _
arg駒配列(i, j).駒位置, _
tmp次位置, _
arg駒配列(i, j).表示名称, _
arg先手)
If Not 王手(ary次局面, arg先手) Then
Exit Function '詰み回避可能
End If
Next
End If
Next: Next
詰み駒移動回避 = False
End Function
Private Function 詰み駒打ち回避(ByRef arg駒配列() As cls駒, _
ByVal arg先手) As Boolean
詰み駒打ち回避 = True 'Trueが詰み回避可能
Dim ary駒台() As String
If arg先手 Then
ary駒台 = obj先手駒台.駒台一覧(Me.手数 - 1)
Else
ary駒台 = obj後手駒台.駒台一覧(Me.手数 - 1)
End If
Dim ary盤面() As String
ary盤面 = obj将棋盤.現在盤面(Me.手数 - 1)
Dim ary次局面() As cls駒
Dim tmp次位置 As g位置
Dim i As Long, j As Long, k As Long
Dim flg禁じ手 As Boolean
'持駒のどの駒をどこに打っても王手のまま
For k = 1 To 7
If ary駒台(k, 2) > 0 Then
For i = 1 To 9: For j = 1 To 9
If arg駒配列(i, j) Is Nothing Then
ary次局面 = 着手後盤面(arg駒配列, _
g位置(0, 0), _
g位置(i, j), _
ary駒台(k, 1), _
arg先手)
flg禁じ手 = False
flg禁じ手 = 反則二歩(arg駒配列, ary盤面, g位置(0, 0), g位置(i, j), ary駒台(k, 1), arg先手, False)
If Not flg禁じ手 Then
flg禁じ手 = 反則不動駒(arg駒配列, ary盤面, g位置(0, 0), g位置(i, j), ary駒台(k, 1), arg先手, False)
End If
If Not flg禁じ手 Then
If Not 王手(ary次局面, arg先手) Then
Exit Function '詰み回避可能
End If
End If
End If
Next: Next
End If
Next
詰み駒打ち回避 = False
End Function
'**********************************************************************
' 反則・詰みで使う共通関数
'**********************************************************************
Private Function 着手後盤面(ByRef arg駒配列, _
ByVal arg元位置 As g位置, _
ByVal arg先位置 As g位置, _
ByVal arg駒名 As String, _
ByVal arg先手 As Boolean) As cls駒()
Dim ary駒配列() As cls駒
ary駒配列 = arg駒配列
Dim obj駒 As New cls駒
Set ary駒配列(arg先位置.行, arg先位置.列) = obj駒.駒作成(arg駒名, arg先手, arg先位置)
If arg元位置.行 <> 0 Then
Set ary駒配列(arg元位置.行, arg元位置.列) = Nothing
End If
着手後盤面 = ary駒配列
End Function
'arg先手=Trueなら先手に王手がかかっているか判定
Private Function 王手(ByRef ary駒() As cls駒, _
ByVal arg先手 As Boolean) As Boolean
王手 = True
Dim tmp位置 As g位置
Dim tmp駒 As cls駒
Dim i As Long, j As Long
For i = 1 To 9: For j = 1 To 9
If CompProperty(ary駒(i, j), "先手", arg先手, "<>") Then
For Each tmp位置 In ary駒(i, j).駒移動可能位置(ary駒)
Set tmp駒 = ary駒(tmp位置.行, tmp位置.列)
If CompProperty(tmp駒, "表示名称", "玉") And _
CompProperty(tmp駒, "先手", arg先手) Then
Exit Function
End If
Next
End If
Next: Next
王手 = False
End Function
王手がかかっている状態での対応は大きく二通りあります。
駒を動かすか、持駒を打つかの二通りです。
もちろん、動かす駒には王将そのものも含まれます。
反則の最後に打ち歩詰めを入れました
Public Function 反則(ByVal arg元選択 As Range, _
ByVal arg先選択 As Range) As Boolean
反則 = True
If RunAuto Then Exit Function
Dim ary駒配列() As cls駒
Dim ary盤面() As String
Dim tmp駒名 As String
Dim tmp元位置 As g位置
Dim tmp先位置 As g位置
'個別反則判定プロシージャーへ引き渡す情報を作成
ary駒配列 = obj将棋盤.駒配列(Me.手数 - 1)
ary盤面 = obj将棋盤.現在盤面(Me.手数 - 1)
tmp駒名 = arg元選択.Value
Set tmp元位置 = セル2位置(arg元選択)
Set tmp先位置 = セル2位置(arg先選択)
If 選択場所(arg元選択) = e場所.先手持駒 Or 選択場所(arg元選択) = e場所.後手持駒 Then
Set tmp元位置 = g位置(0, 0)
End If
'3.二歩：歩を打つ時に同列にすでに歩が存在する場合
If 反則二歩(ary駒配列, ary盤面, tmp元位置, tmp先位置, tmp駒名, Me.先手) Then
Exit Function 'Trueが反則
End If
'4.身動きの取れない駒を打つ：香と歩は1段、桂は2段に打てない：Trueが反則
If 反則不動駒(ary駒配列, ary盤面, tmp元位置, tmp先位置, tmp駒名, Me.先手) Then
Exit Function 'Trueが反則
End If
'5.王手放置：王将が取られる状態を回避しない場合：Trueが反則
If 反則王手放置(ary駒配列, ary盤面, tmp元位置, tmp先位置, tmp駒名, Me.先手) Then
Exit Function 'Trueが反則
End If
'6.打ち歩詰め打ち歩詰め
If 反則打歩詰め(ary駒配列, ary盤面, tmp元位置, tmp先位置, tmp駒名, Me.先手) Then
Exit Function 'Trueが反則
End If
反則 = False
End Function
Excel将棋のダウンロード
Excel将棋の目次
№1. Excel将棋：マクロVBAの学習用
・Excel将棋の要件定義 ・Excel将棋のシート作成 ・Excel将棋の目次
№2. Excel将棋：クラスの設計・作成するクラスの役割と作成順 ・作成するクラスのメンバー一覧 ・駒の移動の定義 ・Excel将棋の目次
№3. Excel将棋：駒クラスの作成・位置クラス ・移動クラス ・駒クラス ・駒クラスVBAの解説 ・使用しているVBAの参考ページ ・Excel将棋の目次
№4. Excel将棋：駒クラスの単体テスト・駒クラスのテスト内容 ・駒クラスのテストVBAコード ・駒クラスのテストVBAの結果 ・Excel将棋の目次
№5. Excel将棋：駒台クラスの作成&単体テスト・駒クラス ・駒台クラスVBAの解説 ・駒台クラスのテストVBAコード ・駒クラスのテストVBAの結果 ・Excel将棋の目次
№6. Excel将棋：位置クラスをデフォルトインスタンスに変更・デフォルトインスタンスに変更する理由と方法 ・位置クラスのインポート用ソース ・cls位置とg位置の使い方の違い ・位置クラス変更に伴う駒クラスの変更 ・Excel将棋の目次
№7. Excel将棋：将棋盤クラスの作成&単体テスト・将棋盤クラス ・将棋盤クラスVBAの解説 ・将棋盤クラスのテストVBAコード ・将棋盤クラスのテストVBAの結果 ・Excel将棋の目次
№8. Excel将棋：将棋進行クラスの作成・将棋進行クラス ・将棋進行クラスVBAの解説 ・将棋進行クラスの起動方法 ・将棋盤クラスのテストVBAの結果 ・Excel将棋の目次
№9. Excel将棋：駒を動かす・駒クラスにプロパティ追加 ・将棋進行クラスの変更点 ・将棋進行クラスのVBA ・Excel将棋の実行動作 ・Excel将棋の目次
№10. Excel将棋：相手の駒を取る、持ち駒を打つ・主な変更追加箇所 ・全体の構成 ・Excel将棋の動作 ・Excel将棋の全VBAコード ・Excel将棋の目次
№11. Excel将棋：駒を成る・主な変更追加箇所 ・Excel将棋の動作 ・変更したクラスのVBA ・Excel将棋の目次
№12. Excel将棋：棋譜をユーザーフォームに表示する・棋譜について ・主な変更内容 ・ユーザーフォームの作成 ・Excel将棋の動作 ・変更したクラスのVBA ・Excel将棋の目次
№13. Excel将棋：棋譜選択でその時点の盤面に戻す・Excel将棋の動作 ・全体構成図 ・全プロシージャー・プロパティの一覧 ・クリックで着手した時の主なプロシージャーの流れ ・Excel将棋のダウンロード ・Excel将棋の目次
№14. Excel将棋：棋譜ファイルの出力と読込自動再生・Excel将棋の動作 ・VBAの修正箇所について ・Excel将棋のダウンロード ・棋譜KIFファイルのサンプル ・Excel将棋の目次
№15. Excel将棋：反則（禁じ手）判定・反則（禁じ手） ・Excel将棋の動作 ・各クラスの共通で持つプロパティを整理 ・VBAの修正箇所について ・Excel将棋のダウンロード ・Excel将棋の目次
№16. Excel将棋：終局（詰み）判定と打ち歩詰め・反則（禁じ手） ・Excel将棋の動作 ・VBAの追加・修正箇所について ・Excel将棋のダウンロード ・Excel将棋の目次
№17. Excel将棋：千日手と連続王手の千日手・反則（禁じ手） ・Excel将棋の動作 ・VBAの修正箇所について ・Excel将棋のダウンロード ・Excel将棋の目次
№18 Excel将棋：ひとまず完成、これまでとこれから・Excel将棋のこれから ・Excel将棋の目次 ・Excel将棋のダウンロード ・当初のクラス設計 ・作成するクラスのメンバー一覧 ・全体構成図 ・全プロシージャー・プロパティの一覧 ・全VBAコード
№19 Excel将棋：棋譜ファイルから対局一覧作成・対局一覧のシート ・Excel将棋の動作 ・全体構成図 ・Excel将棋のダウンロード ・新規追加したVBAコード ・Excel将棋の目次
新着記事NEW ・・・新着記事一覧を見る
シートコピー後のアクティブシートは何か｜ツイッター出題回答 (2023-09-19)
Excel関数の引数を省略した場合について｜ツイッター出題回答 (2023-09-14)
セル個数を返すRange.CountLargeプロパティとは｜VBA技術解説(2023-09-08)
記号を繰り返してグラフ作成（10単位で折り返す）｜ツイッター出題回答 (2023-08-28)
シートを削除：不定数のシート名に対応｜VBAサンプル集(2023-08-24)
ランクによりボイントを付ける（同順位はポイントを分割）｜ツイッター出題回答 (2023-08-22)
OneDrive使用時のThisWorkbook.Pathの扱い方｜VBA技術解説(2023-07-26)
列幅不足による###表示や指数表示を判定する｜VBA技術解説(2023-07-12)
シートを削除：不定数のシート名に対応｜VBAサンプル集(2023-07-04)
シート関数のCOUNTIFS,SUMIFS,MAXIFSと同じ処理｜Power Query（M言語）入門(2023-02-28)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.変数宣言のDimとデータ型｜VBA入門
5.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
6.マクロとは？VBAとは？VBAでできること｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
10.条件分岐（IF）｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- Excel将棋：終局（詰み）判定と打ち歩詰め(№16)
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。