Excel将棋：千日手と連続王手の千日手(№17)
Excelで将棋を作ってみましょう。
人vs人で動かしてゲームとして成立するところまでが当面の目標です。
千日手は、他とは違ってある局面だけでは判定できません。
棋譜を遡って、同一局面が4回出現したかを比較しなければなりません。
反則（禁じ手）
1.二手指し
2.動けないところに駒を進める：自動で成る
3.二歩
4.身動きの取れない駒を打つ：先手は1段目に歩を打てない
5.王手放置
2.動けないところに駒を進める：自動で成る
3.二歩
4.身動きの取れない駒を打つ：先手は1段目に歩を打てない
5.王手放置
前々回、Excel将棋：反則（禁じ手）判定 こちらで実装済み。
・反則（禁じ手） ・Excel将棋の動作 ・各クラスの共通で持つプロパティを整理 ・VBAの修正箇所について ・Excel将棋のダウンロード ・Excel将棋の目次
6.打ち歩詰め
前回、 Excel将棋：終局（詰み）判定と打ち歩詰め こちらで実装しました。
・反則（禁じ手） ・Excel将棋の動作 ・VBAの追加・修正箇所について ・Excel将棋のダウンロード ・Excel将棋の目次
7.連続王手の千日手
まず千日手の判定が必要です。
千日手の判定と、連続王手だったかの判定を組み込みます。
ただし、実際にプログラミングしてみるといろいろ難しい事がありました。
同一局面が4回、この最初の局面を作り出したのが王手とは限らず、
玉が動いた時点が開始局面の場合、最後も玉が動いて成立することになります。
つまりこの場合は、王手はまだ千日手ではなく、玉が動いて初めて成立します。
他の反則は着手できないようにしましたが、
連続王手は、着手できないようにするわけにはいきません。
したがって、「連続王手の千日手」これは王手している側を負けの判定にしました。
千日手の判定と、連続王手だったかの判定を組み込みます。
ただし、実際にプログラミングしてみるといろいろ難しい事がありました。
玉が動いた時点が開始局面の場合、最後も玉が動いて成立することになります。
つまりこの場合は、王手はまだ千日手ではなく、玉が動いて初めて成立します。
連続王手は、着手できないようにするわけにはいきません。
したがって、「連続王手の千日手」これは王手している側を負けの判定にしました。
Excel将棋の動作
現時点の動作です。
千日手
連続王手の千日手
VBAの修正箇所について
以下では、今回の千日手に関係して修正・追加した主なプロシージャーを掲載します。
cls将棋進行
着手の最後に千日手と連続王手の千日手の判定を入れました。
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
'千日手：連続王手の千日手は半策として負けにします。
Dim 千日手開始手数 As Long, 反則勝ち As String
If 千日手(千日手開始手数) Then
反則勝ち = 連続王手の千日手(千日手開始手数)
If 反則勝ち <> "" Then
Call obj将棋盤.棋譜終局追加("連続王手の千日手")
Call frm棋譜.棋譜表示(obj将棋盤.棋譜履歴, obj将棋盤.開始時刻, obj将棋盤.最終時刻)
MsgBox "連続王手の千日手で反則です。" & vbLf & vbLf & _
反則勝ち & "の勝ちです。"
Else
Call obj将棋盤.棋譜終局追加("千日手")
Call frm棋譜.棋譜表示(obj将棋盤.棋譜履歴, obj将棋盤.開始時刻, obj将棋盤.最終時刻)
MsgBox "このままじゃ決着がつかん・・・" & vbLf & vbLf & _
"千日手が成立しました。"
End If
End If
End Sub
着手の最後、つまり実際に着手されて局面が進んだ後に千日手の判定を行い、
千日手が成立していたら、連続王手の千日手の判定を行うようにしています。
千日手の実装で新規に作成したプロシージャー
'**********************************************************************
' 千日手：連続王手の千日手は着手不可にせずに負けにします
'**********************************************************************
Private Function 千日手(ByRef arg千日手開始手数 As Long) As Boolean
If obj将棋盤.千日手(arg千日手開始手数) And _
obj先手駒台.千日手() And _
obj後手駒台.千日手() Then
千日手 = True
Else
千日手 = False
End If
End Function
Private Function 連続王手の千日手(ByVal arg千日手開始手数 As Long) As String
Dim i As Long
Dim flg1 As Boolean: flg1 = True
For i = arg千日手開始手数 To Me.手数 - 1 Step 2
If Not 王手(obj将棋盤.駒配列(i), CBool(i Mod 2 = 0)) Then
flg1 = False
Exit For
End If
Next
Dim flg2 As Boolean: flg2 = True
For i = arg千日手開始手数 + 1 To Me.手数 - 1 Step 2
If Not 王手(obj将棋盤.駒配列(i), CBool(i Mod 2 = 0)) Then
flg2 = False
End If
Next
連続王手の千日手 = ""
If flg1 Then
連続王手の千日手 = IIf((Me.手数 - 1) Mod 2 = 1, "後手", "先手")
End If
If flg2 Then
連続王手の千日手 = IIf((Me.手数 - 2) Mod 2 = 1, "後手", "先手")
End If
End Function
obj将棋盤.千日手
ここで、千日手の開始局面となる手数をByRefで返しています。
連続王手の千日手では、この開始局面の手数以降の局面において全てが王手かどうかの判定をしています。
そこで、1手ずらした（先手後手双方の）判定を行い、どちらかで連続王手になっているかの判定にしました。
実際の対局で、どのような局面でどのような判定をすべきなのか・・・
いろいろな棋譜でテストしたいところですが、連続王手の千日手で決着した棋譜なんてあるものなのかどうか・・・
cls将棋盤とcls駒台の「千日手」で使用する汎用関数
'2次元配列をJOINします
Public Function Join2DimArray(ByRef argAry() As String) As String
Join2DimArray = ""
Dim i As Long, j As Long
For i = LBound(argAry, 1) To UBound(argAry, 1)
For j = LBound(argAry, 2) To UBound(argAry, 2)
Join2DimArray = Join2DimArray & argAry(i, j)
Next
Next
End Function
VBAのJOIN関数は1次元配列しか対応していません。
シート関数のTEXTJOIN関数やCONCAT関数は2次元配列も扱えますが、最近のバージョンでしか使えないので、これらの関数を使わずにVBAを書きました。
cls将棋盤
千日手の判定として新規に作成したプロシージャー
千日手の開始局面となる手数をByRefで返しています。
親となるcls将棋進行では、この開始局面の手数以降の局面において全てが王手かどうかの判定をしています。
'指定手数の位置と同一局面が4回存在していたらTrueを返す
Public Function 千日手(ByRef arg千日手開始手数 As Long, _
Optional ByVal arg手数 As Long) As Boolean
If arg手数 = 0 Then arg手数 = pCol盤面.Count
If arg手数 < 10 Then Exit Function '千日手にはなりえないので
Dim str盤面 As Variant
str盤面 = Me.Parent.Join2DimArray(Me.現在盤面(arg手数))
Dim cnt As Long, i As Long
For i = arg手数 - 4 To 1 Step -1
If Me.Parent.Join2DimArray(Me.現在盤面(i)) = str盤面 Then
cnt = cnt + 1
If cnt >= 3 Then
arg千日手開始手数 = i
千日手 = True
Exit Function
End If
End If
Next
千日手 = False
End Function
千日手の開始局面となる手数をByRefで返しています。
親となるcls将棋進行では、この開始局面の手数以降の局面において全てが王手かどうかの判定をしています。
cls駒台
千日手の判定として新規に作成したプロシージャー
'指定手数の位置と同一局面が4回存在していたらTrueを返す
Public Function 千日手(Optional ByVal arg手数 As Long) As Boolean
If arg手数 = 0 Then arg手数 = pCol駒台.Count
If arg手数 < 10 Then Exit Function '千日手にはなりえないので
Dim str盤面 As Variant
str盤面 = Me.Parent.Join2DimArray(Me.駒台一覧(arg手数))
Dim cnt As Long, i As Long
For i = arg手数 - 4 To 1 Step -1
If Me.Parent.Join2DimArray(Me.駒台一覧(i)) = str盤面 Then
cnt = cnt + 1
If cnt >= 3 Then
千日手 = True
Exit Function
End If
End If
Next
千日手 = 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 ・・・新着記事一覧を見る
TRIMRANGE関数（セル範囲をトリム：端の空白セルを除外）｜エクセル入門(2024-08-30)
正規表現関数（REGEXTEST,REGEXREPLACE,REGEXEXTRACT）｜エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない｜エクセル雑感(2024-04-11)
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.繰り返し処理（For Next)｜VBA入門
3.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
4.変数宣言のDimとデータ型｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.条件分岐（Select Case）｜VBA入門
10.ブック・シートの選択（Select,Activate）｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- Excel将棋：千日手と連続王手の千日手(№17)
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。