1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

VBAでオセロ作成 #5 スコアボード表示・勝敗判定・パスボタンを実装し完成!

Posted at

本稿では割愛してますが前回のひっくり返し判定に不備があり、デバッグして整備し、ひっくり返せる位置以外に石を置かないように改修しました。そして、石の数を表示するスコアボードとパスボタン、更に勝敗判定も実装し、遂に完成しました。

⒈ ひっくり返し判定改修

Function Stone_Reverse_Right(ByVal Target As Range)
    Dim i As Integer                            '反対の色の石探索用のカウンタ
    i = 1
    Dim a_row, a_col As Integer     '座標変換用変数
    a_row = Target.Row - 3      '選択セルの行を配列上の座標に変換して代入
    a_col = Target.Column - 3       '選択セルの列を配列上の座標に変換して代入
    Dim r As Integer      'ひっくり返す用カウンタ
    If 3 <= Target.Column And Target.Column <= 8 Then     '選択セルの列がエクセル上の座標で3~8の間だったら
        Do While 0 < a_col + i And a_col + i < 7  '左右端を除いた範囲で繰り返す
            If stone_arr(a_row, a_col + i) = "" Then '一つ右の石が空白ならループ抜ける
                Exit Do
            End If
            If stone_arr(a_row, a_col + i) = reverse_stone Then '一つ右の石が反対色の石か?
                If stone_arr(a_row, a_col + i + 1) = stone Then 'さらにもう一つ右の石が同じ色か?
                    r = a_col + i                          'ひっくり返す用カウンタに一個前の列座標を入れる
                    Do While r > a_col                    '石置いた列までひっくり返しループ
                        If stone = BLACK_STONE Then        '置いた石が黒石だったら
                            stone_arr(a_row, r) = BLACK_STONE    '一個前の配列データを●にひっくり返す
                            stone_arr(a_row, a_col) = BLACK_STONE       '置いた黒石の座標を配列へ代入
                        ElseIf stone = WHITE_STONE Then    '置いた石が白石だったら
                            stone_arr(a_row, r) = WHITE_STONE     '一個前の配列データを◯にひっくり返す
                            stone_arr(a_row, a_col) = WHITE_STONE       '置いた白石の座標を配列へ代入
                        End If
                        r = r - 1       'ひっくり返す用カウンタ変数をデクリメント(置いた位置まで戻る)
                    Loop
                End If
            Else    '一つ右の石が同じ色ならループ抜ける
                Exit Do
            End If
            i = i + 1
        Loop
    End If
End Function
```
改修した右方向のひっくり返し判定です。以前はひっくり返し判定をする前にセルに石を代入していましたが、ひっくり返し判定関数の中で置いた石を配列内に格納することで、後に配列内のデータを盤面に反映させた時に石が表示されるよう変更しています。
これによってひっくり返しが起こらない位置に石を置けないように出来ました。

###  スコアボード
````vb
Public blackCount, whiteCount As Long   '黒石と白石カウント変数
```

````vb
    '黒石、白石カウント変数初期化
    blackCount = 2
    whiteCount = 2
```

````vb
    'スコアボード初期化
    Cells(2, 6) = "黒:" & blackCount
    Cells(2, 9) = "白:" & whiteCount
```

````vb
Function ScoreBoard()   '黒石白石数えるよう関数
    Dim i As Long: i = 0
    Dim j As Long: j = 0
    '黒石白石カウント変数初期化
    blackCount = 0
    whiteCount = 0
    
    For i = 0 To 7  'stone_arr配列の中の黒石と白石の数を数える
        For j = 0 To 7
            If stone_arr(i, j) = BLACK_STONE Then
                blackCount = blackCount + 1
            ElseIf stone_arr(i, j) = WHITE_STONE Then
                whiteCount = whiteCount + 1
            End If
        Next
    Next
End Function
```

````vb
        '石が既にあるかの判定
        If Cells(cell_click_row, cell_click_column).Value = "" Then
                        
            '盤面情報保存する
            Call Stone_Map
                        
            '8方向にひっくり返す判定
            Call Stone_Reverse_Right(Target)      '右ひっくり返す判定
            Call Stone_Reverse_Left(Target)     '左ひっくり返す判定
            Call Stone_Reverse_Up(Target)       '上ひっくり返す判定
            Call Stone_Reverse_Down(Target)     '下ひっくり返す判定
            Call Stone_Reverse_UpRight(Target)  '右上ひっくり返す判定
            Call Stone_Reverse_UpLeft(Target)   '左上ひっくり返す判定
            Call Stone_Reverse_DownRight(Target)    '右下ひっくり返す判定
            Call Stone_Reverse_DownLeft(Target)     '左下ひっくり返す判定
            
            '配列データを盤面に反映
            Call ApplyArrayData
            
            'stone_arr配列内の石をカウントしてスコアボード表示
            Call ScoreBoard
            
            'スコアボード更新
            Cells(2, 6) = "黒:" & blackCount
            Cells(2, 9) = "白:" & whiteCount
```
スコアボードはグローバル変数に黒石と白石をカウントした数を入れています。
最初は黒も白も2個なので2で初期化した後、スコアボードを表示したいセルに代入しています。
そして、盤面情報を保存している配列内の石を数える関数をひっくり返し判定の後に呼び出してスコアボードがひっくり返す度に更新されるようにしています。

###  パスボタン

````vb
Sub passBottun()    'パスボタン
    stone_count = stone_count + 1   '手数を進めるためインクリメント
    
    '次の手番黒か白か判定
    If stone_count Mod 2 = 1 Then   'ターン数が偶数回か奇数回かのIf文
    
        '置き終わったら「黒の番です」と表示
        Cells(2, 1) = "「黒の番です」"
        '偶数の場合
        stone = BLACK_STONE     '置く石は黒
        reverse_stone = WHITE_STONE     'ひっくり返す石は白
    Else
        
        '置き終わったら「白の番です」と表示
        Cells(2, 1) = "「白の番です」"
        '奇数の場合
        stone = WHITE_STONE     '置く石は白
        reverse_stone = BLACK_STONE     'ひっくり返す石は黒
    End If
End Sub
```
パスボタンは手数カウンタをインクリメントすることで石を置かないで相手の番にスキップできるようにしています。

###  勝敗判定

````vb
Sub OtheloJudgement()  '勝敗判定用関数
    If blackCount > whiteCount Then '黒石の数が白石より多かったら黒の勝ち
        MsgBox "黒の勝ちです!", vbInformation
    ElseIf blackCount < whiteCount Then '白石の数が黒石より多かったら白の勝ち
        MsgBox "白の勝ちです!", vbInformation
    ElseIf blackCount = whiteCount Then '黒石と白石の数が互角だったら引き分け
        MsgBox "引き分けです!", vbInformation
    End If
    MsgBox "最初からする場合はゲームスタートボタンを押して下さい。"
End Sub

```
````vb
    '黒石と白石の数が盤面を埋め尽くしたら勝敗判定プロシージャを呼び出す
    If blackCount + whiteCount = UBound(stone_arr) * UBound(stone_arr, 2) Then
        Call OtheloJudgement
    End If
```
勝敗判定は黒石・白石カウントの数を比較する関数をギブアップボタンに紐づけて実装しています。
ギブアップボタンを押さなくても、盤面上全てに石が置かれた状態になると勝敗判定プロシージャを呼び出すようにしています。
勝敗判定後は自動でリスタートしない為、"最初からする場合はゲームスタートボタンを押して下さい。"の一文をMsgBoxで表示させています。

![2020-01-06 (3).png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/507713/7f8bef30-4493-d136-07ab-594e3212f72a.png)

![2020-01-06 (4).png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/507713/6192dc06-d940-1449-f225-ef0dcb05ae32.png)

![2020-01-06 (5).png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/507713/6f31a7ee-b6bb-284a-7151-f8d78deda00b.png)


## まとめ
最初作り始めた時はまだVBAにも慣れていなく本当に作れるのか不安でしたが、仕事でもVBAに触れている為、徐々になれていってなんとか完成まで辿り着けました。
VBAは実際に触れるまではちょっとしたマクロしか作れないのでは?という認識でしたがこういったゲームを作ったりともっと凝った内容にすれば他にも面白いゲームから便利なマクロまで幅広いプログラムが組めて奥が深いと感じました。
仕事ではずっと付き合っていく言語になりそうなのでもっと迅速で無駄のないプログラムが組めるよう精進したいと思います。
初心者の為、Qiitaの記事にしては拙い内容でしたが、ここまで読んで頂きありがとうございました。
1
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?