VBAサンプル集
Excel将棋:終局(詰み)判定と打ち歩詰め(№16)

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

Excel将棋:終局(詰み)判定と打ち歩詰め(№16)


VBA マクロ Excel将棋

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


今回は、前回の反則(禁じ手)の続きで「打ち歩詰め」を実装します。
打ち歩詰めを判定するには、そもそも「詰み」の判定が必要です。
つまり、「詰み」の判定を先に入れて、歩を打った時点で「詰み」になる場合は「打ち歩詰め」と判定して着手できないようにします。

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

反則(禁じ手)

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

6.打ち歩詰め
先に詰み判定が必要
詰み判定が完成した後に実装を考える。

7.連続王手の千日手
先に千日手の判定が必要
千日手の判定が完成した後に実装を考える。
次回、なんとか実装を考えます。

Excel将棋の動作

現時点の動作です。

二歩

VBA マクロ Excel将棋

身動きの取れない駒を打つ:先手は1段目に歩を打てない

VBA マクロ Excel将棋

王手放置

VBA マクロ Excel将棋

動けないところに駒を進める:自動で成る

VBA マクロ Excel将棋

打ち歩詰め

VBA マクロ Excel将棋

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将棋のダウンロード

ここまでの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」をお願いいたします。
本文下部へ