ExcelマクロVBAサンプル集 | オセロを作りながらマクロVBAを学ぼう15 | Excelマクロの実用サンプル、エクセルVBA集と解説



最終更新日:2017-12-06

オセロを作りながらマクロVBAを学ぼう15


ExcelマクロVBAでオセロ(リバーシ)を作っていきながらマクロVBAを学ぶ第15回です。

棋譜が扱えるようになり、「待った」の実装も出来ました。

棋譜が扱えるようになったので、今回は、対局を再現できるようにします。
1手1手進められるように、1手1手戻せるようにします。


シートにボタンを追加
下図のように、ボタンを追加します。



オブジェクト名は、
棋譜再現 : btn11
戻る : btn12
進む : btn13
としました。



ボタンクリックのイベントプロシージャー

以下をシートモジュールに追加します。

Private Sub btn11_Click()
  Unprotect
  StopMsg = False
  Set TargetSheet = Sheet1
  Call 棋譜再現
  Protect
End Sub

Private Sub btn12_Click()
  Unprotect
  StopMsg = False
  Set TargetSheet = Sheet1
  Call 棋譜戻る
  Protect
End Sub

Private Sub btn13_Click()
  Unprotect
  StopMsg = False
  Set TargetSheet = Sheet1
  Call 棋譜進む
  Protect
End Sub

イベントプロシージャー内での記述は少なくして、
処理の中核は、標準モジュールに記載します。
イベントプロシージャー内では、エラー時のデバッグ等で使い勝手が良くないので、
なるべく、標準モジュールに書いた方が効率がよいです。



棋譜から対局を再現

以下を、標準モジュールにに追加します。

Sub 棋譜再現()
  With TargetSheet
    If Not StopMsg Then
      If WorksheetFunction.CountA(.Range("盤面")) > 4 And .Range("手番石") <> "" Then
        If MsgBox("対局途中です。" & vbLf & vbLf & _
              "棋譜を再現してもよろしいですか?", _
              vbYesNo, "確認") = vbNo Then
          Exit Sub
        End If
      End If
    End If
    isPCvsPC = False
    .Range("先番石").Copy Destination:=.Range("手番石")
    .Range("手番石").Offset(, 1) = "の番です。"
    .Range("盤面").ClearContents
    Call 共通変数設定
    Call 石を置く(.Range("盤面").Cells(4, 5), 置く石)
    Call 石を置く(.Range("盤面").Cells(5, 4), 置く石)
    Call 石を置く(.Range("盤面").Cells(4, 4), 相手石)
    Call 石を置く(.Range("盤面").Cells(5, 5), 相手石)
    Worksheets("棋譜").Range("D1") = 1
  End With
End Sub

Sub 棋譜進む()
  Dim i As Long
  Dim j As Long
  Dim myRng As Range
  isPCvsPC = False
  With Worksheets("棋譜")
    If .Range("D1") = "" Then
      Exit Sub
    End If
    i = .Range("D1") + 1
    If .Cells(i, 1) = "" Then
      MsgBox "棋譜はここまでです。"
      Exit Sub
    End If
    If .Cells(i, 3) = "黒" Then
      Set 置く石 = TargetSheet.Range("先番石")
    Else
      Set 置く石 = TargetSheet.Range("後番石")
    End If
    Set myRng = 棋譜ToRange(.Cells(i, 2))
'    Call 石を置く(myRng, 置く石)
'    For j = 4 To .Cells(i, .Columns.Count).End(xlToLeft).Column
'      Set myRng = 棋譜ToRange(.Cells(i, j))
'      Call 石を置く(myRng, 置く石)
'    Next
    Call is置ける全方向(myRng, False)
    .Range("D1") = i
  End With
  Call 手番交代
End Sub

Sub 棋譜戻る()
  Dim i As Long
  Dim j As Long
  Dim myRng As Range
  isPCvsPC = False
  With Worksheets("棋譜")
    If .Range("D1") = "" Then
      Exit Sub
    End If
    i = .Range("D1")
    If i = 1 Then
      Exit Sub
    End If
    If .Cells(i, 3) = "黒" Then
      Set 置く石 = TargetSheet.Range("後番石")
    Else
      Set 置く石 = TargetSheet.Range("先番石")
    End If
    Set myRng = 棋譜ToRange(.Cells(i, 2))
    myRng = ""
    For j = 4 To .Cells(i, .Columns.Count).End(xlToLeft).Column
      Set myRng = 棋譜ToRange(.Cells(i, j))
      Call 石を置く(myRng, 置く石)
    Next
    .Range("D1") = i - 1
  End With
  Call 手番交代
End Sub

Function 棋譜ToRange(ByVal str As String) As Range
  Dim s1 As String
  Dim s2 As String
  Dim rng As Range
  Dim i As Long
  Dim j As Long
  Set rng = TargetSheet.Range("盤面").Offset(-1, -1).Resize(9, 9)
  s1 = Left(str, 1)
  s2 = Right(str, 1)
  For j = 2 To 9
    If rng.Cells(1, j) = s1 Then
      Exit For
    End If
  Next
  For i = 2 To 9
    If rng.Cells(i, 1) = s2 Then
      Exit For
    End If
  Next
  Set 棋譜ToRange = TargetSheet.Range("盤面").Cells(i - 1, j - 1)
End Function

棋譜再現
ここは、「対戦開始」とほぼ同様で、初期配置までを行っています。

棋譜進む
「進む」ボタンで1手進めます。
棋譜ToRangeで、棋譜の記号をセル(Range)に変換して、
そこに石を置いています。
棋譜シートの、"D1"セルに再現している手数位置を入れて、これでコントロールしています。
'    Call 石を置く(myRng, 置く石)
'    For j = 4 To .Cells(i, .Columns.Count).End(xlToLeft).Column
'      Set myRng = 棋譜ToRange(.Cells(i, j))
'      Call 石を置く(myRng, 置く石)
'    Next
    Call is置ける全方向(myRng, False)
この部分は、
Call is置ける全方向(myRng, False)
これは、通常の対戦時に石を置く時に使っているものをそのまま使っています。
これを使う事で、石を置けば相手の石をひっくり返してくれます。
コメントアウトしている部分は、
Call is置ける全方向(myRng, False)
これの代わりに、棋譜にあるとおりに石を置いて、相手の石をひっくり返すのも棋譜通りに行う場合です。
今回は、通常対戦とおりに、石を置いくことで相手の石もひっくり返しています。
オセロの棋譜がどこかにあったしたら、それを使う事を考慮すれば、
今回のように、棋譜に従って石を置いて、相手の石をひっくり返す法が良いだろうと考えました。

棋譜戻る
「待った」とほぼ動労の内容となります。
棋譜の現在行の内容で石を元に戻し、
棋譜の現在行("D1")を1行戻します。

棋譜ToRange
f5等の記号から、セル(Rangeオブジェクト)に変換しています。
f5
これを
f5に分割し、
盤面の上と左にある記号から検索して、セル位置(行と列)を取得しています。
取得した行と列を、Cellsに入れる事でRangeオブジェクトにしています。



今回で、オセロソフト作成としては完了となります。
強さはそこそこ、使い勝手もそこそこ
と言うところではないでしょうか。

次回は、本シリーズも長期シリーズとなりましたので、
最後のまとめを書いておきたいと思います。


16へ続きます。

全体の目次


ここまでのサンプルファイルのダウンロード




同じテーマ「ExcelマクロVBAサンプル集」の記事

アメブロの記事本文をVBAでバックアップする1
数独(ナンプレ)を解くVBAに挑戦1
数独(ナンプレ)を解くアルゴリズムの要点とパフォーマンスの検証1
ナンバーリンク(パズル)を解くVBAに挑戦1
ナンバーリンクを解くVBAのパフォーマンス改善1

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

大量VlookupをVBAで高速に処理する方法について|ExcelマクロVBA技術解説(12月12日)
オセロを作りながらマクロVBAを学ぼう|ExcelマクロVBAサンプル集(11月26日)
ScreenUpdating=False時にエラー停止後にシートが固まったら|ExcelマクロVBA技術解説(11月21日)
データクレンジングと名寄せ|ExcelマクロVBA技術解説(10月20日)
SUMIFの間違いによるパフォーマンスの低下について|エクセル関数超技(6月17日)
条件式のいろいろな書き方:TrueとFalseの判定とは|ExcelマクロVBA技術解説(6月15日)
空白セルを正しく判定する方法2|ExcelマクロVBA技術解説(5月6日)
フルパスをディレクトリ、ファイル名、拡張子に分ける|ExcelマクロVBA技術解説(4月15日)
テキストボックスの各種イベント|Excelユーザーフォーム入門(4月9日)
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除|ExcelマクロVBAサンプル集(4月4日)

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

1.最終行の取得(End,Rows.Count)|ExcelマクロVBA入門
2.RangeとCellsの使い分け方|ExcelマクロVBA入門
3.変数とデータ型(Dim)|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|ExcelマクロVBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|ExcelマクロVBA入門
6.定数と型宣言文字(Const)|ExcelマクロVBA入門
7.マクロって何?VBAって何?|ExcelマクロVBA入門
8.CSVの読み込み方法|ExcelマクロVBAサンプル集
9.徹底解説(VLOOKUP,MATCH,INDEX,OFFSET)|エクセル関数超技
10.ひらがな⇔カタカナの変換|エクセル基本操作



  • >
  • >
  • >
  • オセロを作りながらマクロVBAを学ぼう15

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


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

    ↑ PAGE TOP