VBAサンプル集
Excel将棋:棋譜ファイルから対局一覧作成(№19)

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

Excel将棋:棋譜ファイルから対局一覧作成(№19)


VBA マクロ Excel将棋

Excelで将棋を作るシリーズの当初目標の、人vs人で動かしてゲームとして成立するところまでは完成しました。


今回は機能拡張として、棋譜ファイルを読み込み対局一覧を作成します。
複数の棋譜ファイルも一度に処理できるようにしています。
また、その一覧のファイル名をダブルクリックすることで、棋譜の自動再現も動くようにしました。

今回追加した機能は以下になります。
・対局一覧シートを追加
・棋譜ファイル(複数可)を読み込み対局一覧を作成
・対局一覧のファイル名ダブルクリックで棋譜を自動再生

対局一覧のシート

VBA マクロ Excel将棋

将棋ウォーズのKIFを参考に作成しています。
以下で、KIFファイルをダウンロードできます。
項目は以下です
開始日時 ・・・ ここのダブルクリックで棋譜の自動再生が始まります。
先手
後手
棋戦
持ち時間
先手の戦型
後手の戦型
先手の手筋
後手の手筋
先手の備考
後手の備考
手合割
手数

Excel将棋の動作

VBA マクロ Excel将棋

全体構成図

VBA マクロ Excel将棋

太線部分が今回新規作成した部分になります。

Excel将棋のダウンロード

№19.Excel将棋:棋譜ファイルから対局一覧作成
shogi_19.zip shogi_19.xlsm ・・・ 現在の最終版

他のゲーム(数独やオセロ)も含めたダウンロード一覧は以下になります。

新規追加したVBAコード

標準モジュール

Option Explicit

Sub ゲーム開始()
  Dim obj将棋 As cls将棋進行
  Set obj将棋 = New cls将棋進行
  obj将棋.ゲーム開始
End Sub

Sub 対局一覧作成()
  Dim vFile As Variant
  vFile = Application.GetOpenFilename(FileFilter:="KIFファイル,*.kif", _
                    MultiSelect:=True)
  If Not IsArray(vFile) Then
    Exit Sub
  End If
  
  Application.ScreenUpdating = False
  
  Dim ws As Worksheet
  Set ws = ActiveSheet
  Dim tbl As ListObject
  Set tbl = getTable(ws, "tbl対局一覧")
  
  Dim lastRow As Long
  lastRow = tbl.DataBodyRange.Rows.Count
  Do Until WorksheetFunction.CountA(tbl.DataBodyRange.Rows(lastRow)) > 0
    lastRow = lastRow - 1
  Loop
  
  On Error Resume Next
  
  Dim objKif読込 As clsKIF読込
  Dim playTime As Date
  Dim i As Long, j As Long
  For i = LBound(vFile) To UBound(vFile)
    Set objKif読込 = New clsKIF読込
    Call objKif読込.棋譜読込(vFile(i))
    With tbl.DataBodyRange
      playTime = objKif読込.開始日時
      j = WorksheetFunction.Match(CDbl(playTime), tbl.DataBodyRange.Columns(tbl.ListColumns("開始日時").Index), 0)
      If Err Then
        lastRow = lastRow + 1
        j = lastRow
      End If
      
      .Cells(j, tbl.ListColumns("開始日時").Index) = objKif読込.開始日時
      .Cells(j, tbl.ListColumns("先手").Index) = objKif読込.先手
      .Cells(j, tbl.ListColumns("後手").Index) = objKif読込.後手
      .Cells(j, tbl.ListColumns("棋戦").Index) = objKif読込.棋戦
      .Cells(j, tbl.ListColumns("持ち時間").Index) = objKif読込.持ち時間
      .Cells(j, tbl.ListColumns("先手の戦型").Index) = objKif読込.先手の戦型
      .Cells(j, tbl.ListColumns("後手の戦型").Index) = objKif読込.後手の戦型
      .Cells(j, tbl.ListColumns("先手の手筋").Index) = objKif読込.先手の手筋
      .Cells(j, tbl.ListColumns("後手の手筋").Index) = objKif読込.後手の手筋
      .Cells(j, tbl.ListColumns("先手の備考").Index) = objKif読込.先手の備考
      .Cells(j, tbl.ListColumns("後手の備考").Index) = objKif読込.後手の備考
      .Cells(j, tbl.ListColumns("手合割").Index) = objKif読込.手合割
      .Cells(j, tbl.ListColumns("手数").Index) = objKif読込.手数
      .Cells(j, tbl.ListColumns("KIFファイル").Index) = vFile(i)
      
      If objKif読込.手数 Mod 2 = 0 Then
        .Cells(j, tbl.ListColumns("先手").Index).Font.Bold = False
        .Cells(j, tbl.ListColumns("後手").Index).Font.Bold = True
      Else
        .Cells(j, tbl.ListColumns("先手").Index).Font.Bold = True
        .Cells(j, tbl.ListColumns("後手").Index).Font.Bold = False
      End If
    End With
  Next
  
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub

Function getTable(ByVal ws As Worksheet, _
         ByVal argName As String) As ListObject
  Set getTable = Nothing
  Dim tbl As ListObject
  For Each tbl In ws.ListObjects
    If tbl.Name = argName Then
      Set getTable = tbl
      Exit Function
    End If
  Next
End Function

シートモジュール:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Intersect(Columns(1), Target.Item(1)) Is Nothing Then
    Exit Sub
  End If
  
  Cancel = True
  
  Worksheets("Excel将棋").Select
  Dim obj将棋 As cls将棋進行
  Set obj将棋 = New cls将棋進行
  obj将棋.ゲーム開始
  Call obj将棋.棋譜読込(Target.Item(1).Value)
End Sub

このシート自体のシート名は任意です。
ただし、このVBAで将棋盤を作成するシートは「Excel将棋」の固定名称にしています。

棋譜読込クラス:cls棋譜読込

Option Explicit

'プロパティ作成を省略した公開変数
Public 先手 As String
Public 後手 As String
Public 開始日時 As Date
Public 棋戦 As String
Public 持ち時間 As Long
Public 先手の戦型 As String
Public 後手の戦型 As String
Public 先手の手筋 As String
Public 後手の手筋 As String
Public 先手の備考 As String
Public 後手の備考 As String
Public 手合割 As String
Public 勝敗コメント As String
Public 手数 As Long

'KIF棋譜形式のclsKIFの配列
Private pAryKIF() As clsKIF

'**********************************************************************
' 公開プロパティ
'**********************************************************************

Public Property Get KIF配列() As clsKIF()
  KIF配列 = pAryKIF
End Property

'**********************************************************************
' イベント
'**********************************************************************

Private Sub Class_Initialize()
  手数 = 0
End Sub

'**********************************************************************
' 公開メソッド
'**********************************************************************

'拡張子".kif"のShift-JISとUTF-8に対応
Public Function 棋譜読込(ByVal argFile As String, _
             Optional ByVal CharSet As String = "SHIFT-JIS") _
             As Boolean
  'KIFファイルを読み込んで配列に
  If KIF棋譜読込(readKif(argFile)) Then
    棋譜読込 = True
  Else
    棋譜読込 = False
  End If
End Function

'KIF形式ファイルからの棋譜の配列を読み盤面を再現する
Private Function KIF棋譜読込(ByRef argAry() As String) As Boolean
  Dim sSplit() As String
  Dim i As Long, j As Long
  
  j = 1
  For i = LBound(argAry) To UBound(argAry)
    Select Case True
      Case Trim(argAry(i)) = ""
        '空行
      Case Left(argAry(i), 1) = "#", Left(argAry(i), 1) = "*"
        'コメント
      Case InStr(argAry(i), ":") >= 1
        Call midString(先手, argAry(i), "先手")
        Call midString(後手, argAry(i), "後手")
        Call midString(開始日時, argAry(i), "開始日時")
        Call midString(棋戦, argAry(i), "棋戦")
        Call midString(持ち時間, argAry(i), "持ち時間")
        Call midString(先手の戦型, argAry(i), "先手の戦型")
        Call midString(後手の戦型, argAry(i), "後手の戦型")
        Call midString(先手の手筋, argAry(i), "先手の手筋")
        Call midString(後手の手筋, argAry(i), "後手の手筋")
        Call midString(先手の備考, argAry(i), "先手の備考")
        Call midString(後手の備考, argAry(i), "後手の備考")
        Call midString(手合割, argAry(i), "手合割")
      Case IsNumeric(Split(Trim(argAry(i)), " ")(0))
        sSplit = Split(Trim(argAry(i)), " ")
        If IsNumeric(sSplit(0)) Then
          ReDim Preserve pAryKIF(1 To j)
          Set pAryKIF(j) = parseKif(argAry(i))
          If pAryKIF(j).手数 < 0 Then
            KIF棋譜読込 = False
            Exit Function
          End If
          If pAryKIF(j).筋 > 0 Then
            If 手数 < pAryKIF(j).手数 Then
              手数 = pAryKIF(j).手数
            End If
          End If
          j = j + 1
        End If
      Case Else
        勝敗コメント = Trim(argAry(i))
    End Select
  Next
  
  KIF棋譜読込 = True
End Function

Private Sub midString(ByRef rtnStr As Variant, _
           ByVal argStr As String, _
           ByVal keyStr As String)
  If Left(Trim(argStr), Len(keyStr) + 1) = keyStr & ":" Then
    Select Case TypeName(rtnStr)
      Case "Date"
        rtnStr = CDate(Trim(Mid(argStr, Len(keyStr) + 2)))
      Case "Long", "Integer", "Double", "Single"
        rtnStr = Val(Trim(Mid(argStr, Len(keyStr) + 2)))
      Case Else
        rtnStr = Trim(Mid(argStr, Len(keyStr) + 2))
    End Select
  End If
End Sub

Private Function parseKif(ByVal argKif As String) As clsKIF
'  On Error GoTo ErrExit
  Set parseKif = New clsKIF
  
  Const cns漢数字 = "一二三四五六七八九"
  Dim sSplit() As String
  argKif = Replace(argKif, "(", " ")
  argKif = Replace(argKif, ")", " ")
  argKif = Replace(argKif, "/", " ")
  argKif = WorksheetFunction.Trim(argKif)
  sSplit = Split(argKif, " ")
  
  parseKif.手数 = sSplit(0)
  If Not IsNumeric(sSplit(0)) Or _
    Left(sSplit(1), 1) < "1" Or Left(sSplit(1), 1) > "9" Then
    parseKif.駒 = sSplit(1)
    Exit Function
  End If
  
  parseKif.筋 = StrConv(Left(sSplit(1), 1), vbNarrow)
  parseKif.段 = InStr(cns漢数字, Mid(sSplit(1), 2, 1))
  If Mid(sSplit(1), 3, 1) = "成" Then
    parseKif.駒 = Mid(sSplit(1), 4, 1)
  Else
    parseKif.駒 = Mid(sSplit(1), 3, 1)
  End If
  If Right(sSplit(1), 1) = "成" Then
    parseKif.成 = "成"
  End If
  
  Select Case UBound(sSplit)
    Case 3
      parseKif.時間1手 = mmss2hhmmss(sSplit(2))
      parseKif.時間累計 = CDate(sSplit(3))
    Case Is >= 4
      parseKif.元筋 = Left(sSplit(2), 1)
      parseKif.元段 = Right(sSplit(2), 1)
      parseKif.時間1手 = mmss2hhmmss(sSplit(3))
      parseKif.時間累計 = CDate(sSplit(4))
    Case Else
      parseKif.手数 = -1
      Exit Function
  End Select
  Exit Function
  
ErrExit:
  parseKif.手数 = -1
End Function

Private Function readKif(ByVal argFile As String, _
             Optional ByVal CharSet As String = "SHIFT-JIS") _
             As String()
  Dim strRec As String
  Dim aryRec() As String
  
  'SHIFT-JISで読んで"先手:"が無ければUTF-8で読み直す
  strRec = readStream(argFile, CharSet)
  If UCase(CharSet) = "SHIFT-JIS" And InStr(strRec, "先手:") = 0 Then
    strRec = readStream(argFile, "UTF-8")
  End If
  
  readKif = Split(Replace(strRec, vbCrLf, vbLf), vbLf)
End Function

Private Function readStream(ByVal argFile As String, _
              ByVal CharSet As String) As String
  With CreateObject("ADODB.Stream")
    .CharSet = CharSet
    .Open
    .LoadFromFile argFile
    readStream = .ReadText
    .Close
  End With
End Function

Private Function mmss2hhmmss(ByVal mmss As String) As Date
  If Len(mmss) = Len(Replace(mmss, ":", "")) + 1 Then
    mmss = "0:" & mmss
  End If
  If IsDate(mmss) Then
    mmss2hhmmss = CDate(mmss)
  Else
    mmss2hhmmss = 0
  End If
End Function

棋譜フォーム「frm棋譜」の中で処理していたKIFファイルの処理をこちらに移動しています。
「frm棋譜」からもこのクラスを通してKIFファイルを処理するように変更しています。

KIFクラス:clsKIF

Option Explicit

Public 手数 As Integer
Public 筋 As Integer
Public 段 As Integer
Public 駒 As String
Public 成 As String
Public 元筋 As Integer
Public 元段 As Integer
Public 時間1手 As Date
Public 時間累計 As Date

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