VBAサンプル集
Excel将棋:千日手と連続王手の千日手(№17)

ExcelマクロVBAの実用サンプル、エクセルVBA集と解説
最終更新日:2020-08-31

Excel将棋:千日手と連続王手の千日手(№17)


VBA マクロ Excel将棋

Excelで将棋を作ってみましょう。
人vs人で動かしてゲームとして成立するところまでが当面の目標です。


今回は、千日手と反則の「連続王手の千日手」を実装します。
千日手は、他とは違ってある局面だけでは判定できません。
棋譜を遡って、同一局面が4回出現したかを比較しなければなりません。

※クラス名、プロシージャー名、変数名に日本語を使用しています。

反則(禁じ手)

1.二手指し
2.動けないところに駒を進める:自動で成る
3.二歩
4.身動きの取れない駒を打つ:先手は1段目に歩を打てない
5.王手放置
前々回、Excel将棋:反則(禁じ手)判定 こちらで実装済み。
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、反則(禁じ手)の判定を入れます。禁じ手は指し手そのものが出来ないようにします。※クラス名、プロシージャー名、変数名に日本語を使用しています。

6.打ち歩詰め
前回、 Excel将棋:終局(詰み)判定と打ち歩詰め こちらで実装しました。
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、前回の反則(禁じ手)の続きで「打ち歩詰め」を実装します。打ち歩詰めを判定するには、そもそも「詰み」の判定が必要です。

7.連続王手の千日手
まず千日手の判定が必要です。
千日手の判定と、連続王手だったかの判定を組み込みます。
ただし、実際にプログラミングしてみるといろいろ難しい事がありました。

同一局面が4回、この最初の局面を作り出したのが王手とは限らず、
玉が動いた時点が開始局面の場合、最後も玉が動いて成立することになります。
つまりこの場合は、王手はまだ千日手ではなく、玉が動いて初めて成立します。

他の反則は着手できないようにしましたが、
連続王手は、着手できないようにするわけにはいきません。
したがって、「連続王手の千日手」これは王手している側を負けの判定にしました。

Excel将棋の動作

現時点の動作です。

千日手

VBA マクロ Excel将棋

連続王手の千日手

VBA マクロ 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将棋盤

千日手の判定として新規に作成したプロシージャー
'指定手数の位置と同一局面が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将棋のダウンロード

ここまでのVBAコードを組み込んだExcelファイルは以下からダウンロード出来ます。

エクセルのサンプルダウンロード

Excel将棋の目次

№1. Excel将棋:マクロVBAの学習用
Excelで将棋を作ってみましょう。今やコンピューター将棋はプロをしのぐ強さです。しかし、Excelでそのようなソフトを作ろうと言うのではありません。と言いますか、残念ながら私には作れません、、、ExcelマクロVBAの学習素材として将棋を作ってみましょう。
№2. Excel将棋:クラスの設計
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、VBAクラスの設計になります。設計といっても、どのようなプロパティ・メソッドをもたせるかといった概要だけです。
№3. Excel将棋:駒クラスの作成
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、駒クラスの作成になります。駒クラスに必要な部品クラスとして、位置クラスと移動クラスを先に作成してから駒クラスの作成に進みます。
№4. Excel将棋:駒クラスの単体テスト
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、前回の№3.Excel将棋:駒クラスの作成、この単体テストになります。駒クラスは、今後作成していく駒台クラス、将棋盤クラスで使用するものです。
№5. Excel将棋:駒台クラスの作成&単体テスト
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、駒台クラスの作成と単体テストになります。作成するクラス全体の設計は、№2.Excel将棋:クラスの設計、こちらを参照してください。
№6. Excel将棋:位置クラスをデフォルトインスタンスに変更
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、前に作った位置クラスをデフォルトインスタンスに変更します。作成するクラス全体の設計は、№2.Excel将棋:クラスの設計、こちらを参照してください。
№7. Excel将棋:将棋盤クラスの作成&単体テスト
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、いよいよ将棋盤クラスを作成します。駒クラスを2次元配列(1To9,1To9)に入れて将棋盤全体を管理します。
№8. Excel将棋:将棋進行クラスの作成
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、シートとやり取りする将棋進行クラスを作成します。ここまでは、作成したクラスのテスト実行用のVBAを別途作成し、結果をイミディエイトウィンドウに表示して確認していました。
№9. Excel将棋:駒を動かす
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、駒を動かします。駒を動かせるように将棋進行クラスを拡張します。将棋進行クラスの完成はまだまだこれからですが、駒を動かせるようになるとゲームらしくなってきます。
№10. Excel将棋:相手の駒を取る、持ち駒を打つ
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、相手の駒を取ったり、持駒を打ったりできるようにします。取った駒は駒台へ移し、駒台から駒を選んで打てるようにします。
№11. Excel将棋:駒を成る
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、駒を成れるようにします。ただし、将棋では成らない選択も出来ますので、成れるタイミングで成るか成らないかを選択できるようにします。
№12. Excel将棋:棋譜をユーザーフォームに表示する
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、ユーザーフォームを作成し、初手からの棋譜を表示できるようにします。シート操作ができるように、ユーザーフォームはモードレスで表示します。
№13. Excel将棋:棋譜選択でその時点の盤面に戻す
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、棋譜フォームの棋譜を選択することで、その時点の盤面に戻す機能を実装します。さらに、その時点から指し継ぐこともできるようにします。
№14. Excel将棋:棋譜ファイルの出力と読込自動再生
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、KIF形式の棋譜ファイルの出力と、KIF形式の棋譜ファイルを読み込んで初手から終局までを自動再生させます。
№15. Excel将棋:反則(禁じ手)判定
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、反則(禁じ手)の判定を入れます。禁じ手は指し手そのものが出来ないようにします。※クラス名、プロシージャー名、変数名に日本語を使用しています。
№16. Excel将棋:終局(詰み)判定と打ち歩詰め
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、前回の反則(禁じ手)の続きで「打ち歩詰め」を実装します。打ち歩詰めを判定するには、そもそも「詰み」の判定が必要です。
№17. Excel将棋:千日手と連続王手の千日手
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。今回は、千日手と反則の「連続王手の千日手」を実装します。千日手は、他とは違ってある局面だけでは判定できません。
№18 Excel将棋:ひとまず完成、これまでとこれから
Excelで将棋を作ってみましょう。人vs人で動かしてゲームとして成立するところまでが当面の目標です。前回でひとまず当初目標の人vs人で動かしてゲームとして成立するところまでできました。連載の途中で、急遽棋譜の出力と読み込んで自動再生も作成しました。
№19 Excel将棋:棋譜ファイルから対局一覧作成
Excelで将棋を作るシリーズの当初目標の、人vs人で動かしてゲームとして成立するところまでは完成しました。今回は機能拡張として、棋譜ファイルを読み込み対局一覧を作成します。複数の棋譜ファイルも一度に処理できるようにしています。



新着記事NEW ・・・新着記事一覧を見る

import文(パッケージ・モジュールのインポート)|Python入門(9月24日)
例外処理(try文)とexception一覧|Python入門(9月23日)
リスト内包表記|Python入門(9月22日)
Pythonの引数は参照渡しだが・・・|Python入門(9月21日)
lambda(ラムダ式、無名関数)と三項演算子|Python入門(9月20日)
関数内関数(関数のネスト)とスコープ|Python入門(9月18日)
関数の定義(def文)と引数|Python入門(9月18日)
組み込み関数一覧|Python入門(9月17日)
辞書(dict型)|Python入門(9月16日)
入力規則への貼り付けを禁止する|VBA技術解説(9月16日)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.マクロはどこに書くの(VBEの起動)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ