目次
はじめに
学んだこと
1.マクロの作成
2.標準モジュールの作成
3.マクロ有効ブックに変更
4.プロシージャと定義方法
5.クリックイベントの取得
6.ボタンの実装
7.マクロからセルに文字を書き込む
8.数値を文字列に変換
9.繰り返し文
10.If文
11.Functionの使い方
作成したオセロのソースコード
参考サイト
さいごに
はじめに
今回は以下サイトの記事をもとに、VBAでオセロゲームの作成をおこないました。
（サイト内のリンクからそれぞれの記事への遷移ができないため、すべての記事を、
目次の「参考サイト」部分に貼り付けております。）
作成していくうちに⑮以降の記事更新が途絶えていることに気づき、
オセロの石を裏返す処理は自作となっております。また、黒と白どちらの番か、
それぞれの石の枚数の表示も追加実装しております。
現状、左下、右下の石の判定がうまく動かないことがあり、まだ解決できておりません。
ですががせっかく作成したので、一旦学んだことをこちらにアウトプットさせていただきます。
具体的な作成方法についてはこちらの記事で説明されているため、
この記事では今回のオセロ作成で「学んだこと」を記録と復習のためにまとめてみようと思います。
学んだこと
※VBAはプログラミング言語、マクロは機能。
1. マクロの作成
Macの場合は、[Excel] > [環境設定] > [リボンとツールバー] に移動、
[リボンのカスタマイズ] を [メイン タブ] にし、[開発] チェックボックスにチェックをつける。
2. 標準モジュールの作成
VBAProject（エクセルのシート名.xlsm）を右クリック［挿入］>［標準モジュール］を選択、
作成された「Module1」がプログラミングを書いていくもの。
3. マクロ有効ブックに変更
Excelの上書き保存（Ctrl＋S）時表示されるダイアログで「いいえ」を選択し、
マクロ有効ファイルとして保存。
4. プロシージャと定義方法
◆ プロシージャ
何度も行う処理を一纏めにして名前をつけておくもの。
◆ Subプロシージャ
呼び出された際に返答を返さない（名前を読んでも返事をしない）プロシージャのこと。
◆ Call モジュール名.メソッド名()
戻り値なしのプロシージャ呼び出しはCallステートメント使用。（省略も可能）
' 石を裏返す処理を呼び出す
Call change_stone(cell_click_row, cell_click_column, stone, reverse_stone)
' 石を裏返す処理
Sub change_stone(cell_row, cell_column, stone, reverse_stone)
'（処理省略）
End Sub
◆ 定数の定義
「Const 名前 As データ型 = 値」のように定義。
◆ 変数の定義
「Dim 名前 As データ型」のように定義（値を最初に入れておく必要はない）。
◆ すべてのマクロで使える変数の定義
「Public 変数名 AS データ型」で定義。
Const BLACK_STONE As String = "●"
Const WHITE_STONE As String = "○"
' 手数を数える際に使用
Public stone_count As Integer
Sub start_button_Click()
' 変数を定義（盤の中央左上）
Dim center_row As Integer
Dim center_column As Integer
End Sub
※コメントアウトは「’」で記載。
5. クリックイベントの取得
今回は、セルをダブルクリックされたときに石を配置するよう実装。
下記記事どおりにやると、Macでは手順②部分で「Visual Basicでサポートされていないオートメーションが変数で使用されています。」というエラーが発生するので、Macのやり方を記載。
【手順】
① オセロ盤があるシートをダブルクリック
② 開いたウィンドウで［General］のドロップダウンを「Worksheet」に変更
→ Macでは「Visual Basicでサポートされていないオートメーションが変数で使用されています。」というエラーが発生。Excel for Macのバグなので必ず発生するそう。（以下要参照）
③ 下記サイトの回避策3を、モジュールではなくシートのほうに記載したが、ダブルクリックしてもイベント起こらないため、
下記のように記載を修正したところ正常に動いた。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "ダブルクリックされました"
End Sub
※「Cancel = True」でセル内の編集モードをキャンセル。
※「target」にセルの情報が格納されている。
6. ボタンの実装
【手順】
①Excelでボタンを作成。
②［開発］>［VisualBasic］起動。
③プロシージャ内にソースコード記載、保存（Ctl+S）。
④ボタンを右クリックし［マクロの登録］から、作成したプロシージャを選択。
Sub start_button_Click()
MsgBox "ゲームスタート"
End Sub
◆ MsgBox ”出力文字”
プロシージャが動くとメッセージが表示されるようになる。
7. マクロからセルに文字を書き込む
「Cells(行番号, 列番号).Value = "文字"」を記載。
◆ Cells(行番号, 列番号).Value
セルの値を取得する。
' 石、初期配置
Cells(6, 5).Value = "○"
Cells(7, 5).Value = "●"
Cells(6, 6).Value = "●"
Cells(7, 6).Value = "○"
8. 数値を文字列に変換
◆ Str(数値)
Str関数を使用。「Str(数値)」を記載。
' それぞれの枚数を初期化
white_count = 2
black_count = 2
' それぞれの枚数を表示
Cells(11, 2).Value = "白：" + Str(white_count) + "枚"
Cells(11, 5).Value = "黒：" + Str(black_count) + "枚"
9. 繰り返し文
◆ For文
For カウンタ = 初期値 To 終了値
処理
Next
' 盤の石をすべてクリア
For i = 3 To 10
For j = 2 To 9
Cells(i, j).Value = ""
Next
Next
◆ Do While文
Do While 条件式
繰り返したい処理
Loop
※条件式が満たされている間だけ繰り返しを行う
' 石があるかどうか、左方向チェックの関数
Function left_change_check(cell_row, cell_column, stone, reverse_stone)
Dim check_result As Boolean
check_result = False
' 盤の終わりまで左側のセルを見ていく
Do While i >= 2
' 石がない場合はループを抜ける
If Cells(cell_row, i).Value = "" Then
Exit Do
End If
' 同色の石があるかどうか確認
If Cells(cell_row, i).Value = stone Then
check_result = True
Exit Do
End If
i = i - 1
Loop
left_change_check = check_result
End Function
10. If文
◆ If文
If 条件式 Then
条件式が真の時の処理
Else
条件式が偽の時の処理
End If
Const BLACK_STONE As String = "●"
Const WHITE_STONE As String = "○"
' 手数を数える際に使用
Public stone_count As Integer
Dim stone As String
Dim reverse_stone As String
' 今回の例用に作成
stone_count = 4
If stone_count Mod 2 = 1 Then
' 手数 ÷ 2 が余り1の場合（奇数の場合）
stone = WHITE_STONE
reverse_stone = BLACK_STONE
Else
' 割りきれる場合（偶数の場合）
stone = BLACK_STONE
reverse_stone = WHITE_STONE
End If
◆ mod（上記ソース内で使用しているため記載）
modはVBAで割り算の余りを求めるもの。
今回は手数が偶数のときは白、奇数のときは黒を置くよう実装するために使用。
「手数 mod 2 = 1」で、手数を2で割って余りが1ならば奇数、それ以外であれば偶数と判別。
※If文の条件を改行したい時は、以下のように「_（アンダーバー）」を使用。
' 裏返す石が存在するかチェックする処理
Function change_check(cell_row, cell_column, stone, reverse_stone)
check_result = False
' 見本どおりだと「コンパイル エラーです。: 引数の数が正しくないか、
' またはプロパティの指定が無効です。」がでるため、末尾のFalse削除
If left_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
right_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
up_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
down_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
left_up_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
right_up_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
left_down_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
right_down_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
check_result = True
End If
change_check = check_result
End Function
11. Functionの使い方
◆ Function
戻り値がある場合や、関数として使用したい場合に使用。
戻り値がなく関数としても使用しないのであればSubを使用する。
Function プロシージャ名()
処理の内容
End Function
' ① 裏返す石が存在するかチェックする処理を呼び出し
If change_check(cell_click_row, cell_click_column, stone, reverse_stone) = True Then
' Trueの場合、石を置く
Cells(Target.Row, Target.Column).Value = stone
End If
' ② 裏返す石が存在するかチェックする処理
Function change_check(cell_row, cell_column, stone, reverse_stone)
check_result = False
' ③ 左側のチェックメソッドを呼び出し（今回の例用に作成）
If left_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
check_result = True
End If
change_check = check_result
End Function
' ④ 左側のチェックメソッド
Function left_change_check(cell_row, cell_column, stone, reverse_stone)
'（処理の記載省略）
End Function
作成したオセロのソースコード
VBA
' 定数を定義（盤の左上）
Const LEFT_TOP_LOW As Integer = 3
Const LEFT_TOP_COLUMN As Integer = 2
Const BLACK_STONE As String = "●"
Const WHITE_STONE As String = "○"
' 手数を数える際に使用
Public stone_count As Integer
' ★じぶんで追加実装 ★
' それぞれの枚数を数える際に使用
Public white_count As Integer
Public black_count As Integer
Sub start_button_Click()
MsgBox "ゲームスタート"
' 手数の初期化
stone_count = 1
' それぞれの枚数を初期化
white_count = 2
black_count = 2
' 盤の石をすべてクリア
For i = 3 To 10
For j = 2 To 9
Cells(i, j).Value = ""
Next
Next
' 変数を定義（盤の中央左上）
Dim center_row As Integer
Dim center_column As Integer
' 真ん中の4マスの左上のセルの位置を計算
center_row = LEFT_TOP_LOW + 3
center_column = LEFT_TOP_COLUMN + 3
' 初期配置
Cells(center_row, center_column).Value = "○"
Cells(center_row, center_column + 1).Value = "●"
Cells(center_row + 1, center_column).Value = "●"
Cells(center_row + 1, center_column + 1).Value = "○"
' ★じぶんで追加実装 ★
' 最初、誰の番か表示
Cells(1, 5).Value = "白の番です"
' ★じぶんで追加実装 ★
' それぞれの枚数を表示
Cells(11, 2).Value = "白：" + Str(white_count) + "枚"
Cells(11, 5).Value = "黒：" + Str(black_count) + "枚"
End Sub
Sub cell_DoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cell_click_row As Integer
Dim cell_click_column As Integer
cell_click_row = Target.Row
cell_click_column = Target.Column
' 盤上か判定
If cell_click_row >= 3 And 10 >= cell_click_row And cell_click_column >= 2 And 9 >= cell_click_column Then
' セル内の編集モードをキャンセル
Cancel = True
' 石を置ける場所か判定
If Cells(cell_click_row, cell_click_column).Value = "" Then
Dim stone As String
Dim reverse_stone As String
If stone_count Mod 2 = 1 Then
' 手数 ÷ 2 が 1 の場合（奇数の場合）
stone = WHITE_STONE
reverse_stone = BLACK_STONE
Else
' 割りきれる場合（偶数の場合）
stone = BLACK_STONE
reverse_stone = WHITE_STONE
End If
If change_check(cell_click_row, cell_click_column, stone, reverse_stone) = True Then
' 石を置く
Cells(Target.Row, Target.Column).Value = stone
' ★じぶんで追加実装 ★
' 石を裏返す処理を呼び出す
Call change_stone(cell_click_row, cell_click_column, stone, reverse_stone)
' 手数をカウントアップ
stone_count = stone_count + 1
' ★じぶんで追加実装 ★
' 誰の番か表示
If stone_count Mod 2 = 1 Then
' 手数 ÷ 2 が 1 の場合（奇数の場合）
Cells(1, 5).Value = "つぎは白の番です"
Else
' 割りきれる場合（偶数の場合）
Cells(1, 5).Value = "つぎは黒の番です"
End If
' ★じぶんで追加実装 ★
' それぞれの枚数を表示
' 初期化
white_count = 0
black_count = 0
' 盤の石をすべて調べる
For i = 2 To 11
For j = 1 To 10
' 白がある場合
If Cells(i, j).Value = "○" Then
white_count = white_count + 1
End If
' 黒がある場合
If Cells(j, i).Value = "●" Then
black_count = black_count + 1
End If
Next
Next
' 初期化
Cells(11, 2).Value = ""
Cells(11, 5).Value = ""
' それぞれの枚数を表示
Cells(11, 2).Value = "白：" + Str(white_count) + "枚"
Cells(11, 5).Value = "黒：" + Str(black_count) + "枚"
Else
MsgBox "裏返す石がないので置くことができません。"
End If
Else
MsgBox " すでに石が置かれています。"
End If
Else
MsgBox "盤の上ではありません。"
End If
End Sub
' 裏返す石が存在するかチェックする処理
Function change_check(cell_row, cell_column, stone, reverse_stone)
check_result = False
' 見本どおりだと「コンパイル エラーです。: 引数の数が正しくないか、またはプロパティの指定が無効です。」がでるため末尾のFalse削除
If left_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
right_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
up_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
down_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
left_up_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
right_up_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
left_down_change_check(cell_row, cell_column, stone, reverse_stone) = True Or _
right_down_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
check_result = True
End If
change_check = check_result
End Function
' ★じぶんで追加実装 ★
' 石を裏返す処理
Sub change_stone(cell_row, cell_column, stone, reverse_stone)
' 同色の石がある列
Dim same_color_stone_column As Integer
' 左側の石を裏返す
If left_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
' すぐ隣の石
i = cell_column - 1
' 盤の終わりまで左側のセルを見ていく
Do While i >= LEFT_TOP_COLUMN
' 同色の石がある場合
If Cells(cell_row, i).Value = stone Then
' 列を取得
same_color_stone_column = i
Exit Do
End If
i = i - 1
Loop
' 石の数 = いま石を置く列 - 同色の石がある列 - 1
stone_num = cell_column - same_color_stone_column - 1
' 同色の石があるところまで、石を同色に変える
For j = cell_column - stone_num To cell_column
Cells(cell_row, j).Value = stone
Next
End If
' 右側の石を裏返す
If right_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
' すぐ隣の石
i = cell_column + 1
' 盤の終わりまで右側のセルを見ていく
Do While i <= LEFT_TOP_COLUMN + 7
' 同色の石がある場合
If Cells(cell_row, i).Value = stone Then
' 列を取得
same_color_stone_column = i
Exit Do
End If
i = i + 1
Loop
' 石の数 = 同色の石がある列 - いま石を置く列 - 1
stone_num = same_color_stone_column - cell_column - 1
' 同色の石があるところまで、石を同色に変える
For j = cell_column To cell_column + stone_num
Cells(cell_row, j).Value = stone
Next
End If
' 上側の石を裏返す
If up_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
' すぐ上の石
i = cell_row - 1
' 盤の終わりまで上側のセルを見ていく
Do While i >= LEFT_TOP_LOW
' 同色の石がある場合
If Cells(i, cell_column).Value = stone Then
' 行を取得
same_color_stone_row = i
Exit Do
End If
i = i - 1
Loop
' 石の数 = いま石を置く行 - 同色の石がある行
stone_num = cell_row - same_color_stone_row - 1
' 同色の石があるところまで、石を同色に変える
For j = cell_row - stone_num To cell_row
Cells(j, cell_column).Value = stone
Next
End If
' 下側の石を裏返す
If down_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
' すぐ下の石
i = cell_row + 1
' 盤の終わりまで上側のセルを見ていく
Do While i <= LEFT_TOP_LOW + 7
' 同色の石がある場合
If Cells(i, cell_column).Value = stone Then
' 行を取得
same_color_stone_row = i
Exit Do
End If
i = i + 1
Loop
' 石の数 = 同色の石がある行 - いま石を置く行
stone_num = same_color_stone_row - cell_row - 1
' 同色の石があるところまで、石を同色に変える
For j = cell_row To cell_row + stone_num
Cells(j, cell_column).Value = stone
Next
End If
' 左上側の石を裏返す
If left_up_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
' すぐ左上の石
i = cell_column - 1
j = cell_row - 1
' 盤の左上の座標よりも大きい場合は、処理を続ける
Do While i >= LEFT_TOP_COLUMN And j >= LEFT_TOP_ROW
' 同色の石がある場合
If Cells(j, i).Value = stone Then
' 列と行を取得
same_color_stone_column = i
same_color_stone_row = j
Exit Do
End If
i = i - 1
j = j - 1
Loop
' 同色の石からいま置く石までを数える
column_num = cell_column - same_color_stone_column - 1
row_num = cell_row - same_color_stone_row - 1
' 列数と行数が同じであることを確認
If column_num = row_num Then
' 同色の石があるところまで、石を同色に変える
For n = 1 To column_num
Cells(cell_row - n, cell_column - n).Value = stone
Next
End If
End If
' 左下側の石を裏返す
If left_down_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
' すぐ左下の石
i = cell_column - 1
j = cell_row + 1
' 盤の左下の座標よりも小さい場合は、処理を続ける
Do While i >= LEFT_TOP_COLUMN And j <= LEFT_TOP_ROW + 7
' 同色の石がある場合
If Cells(j, i).Value = stone Then
' 列と行を取得
same_color_stone_column = i
same_color_stone_row = j
Exit Do
End If
i = i - 1
j = j + 1
Loop
' 同色の石からいま置く石までを数える
column_num = cell_column - same_color_stone_column - 1
row_num = same_color_stone_row - cell_row - 1
' 列数と行数が同じであることを確認
If column_num = row_num Then
' 同色の石があるところまで、石を同色に変える
For n = 1 To column_num
Cells(cell_row + n, cell_column - n).Value = stone
Next
End If
End If
' 右上側の石を裏返す
If right_up_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
' すぐ右上の石
i = cell_column + 1
j = cell_row - 1
' 盤の右上の座標よりも大きい場合は、処理を続ける
Do While i >= LEFT_TOP_COLUMN And j >= LEFT_TOP_ROW
' 同色の石がある場合
If Cells(j, i).Value = stone Then
' 列と行を取得
same_color_stone_column = i
same_color_stone_row = j
Exit Do
End If
i = i + 1
j = j - 1
Loop
' 同色の石からいま置く石までを数える
column_num = same_color_stone_column - cell_column - 1
row_num = cell_row - same_color_stone_row - 1
' 列数と行数が同じであることを確認
If column_num = row_num Then
' 同色の石があるところまで、石を同色に変える
For n = 1 To column_num
Cells(cell_row - n, cell_column + n).Value = stone
Next
End If
End If
' 右下側の石を裏返す
If right_down_change_check(cell_row, cell_column, stone, reverse_stone) = True Then
' すぐ右下の石
i = cell_column + 1
j = cell_row + 1
' 盤の右下の座標よりも大きい場合は、処理を続ける
Do While i <= LEFT_TOP_COLUMN + 7 And j <= LEFT_TOP_ROW + 7
' 同色の石がある場合
If Cells(j, i).Value = stone Then
' 列と行を取得
same_color_stone_column = i
same_color_stone_row = j
Exit Do
End If
i = i + 1
j = j + 1
Loop
' 同色の石からいま置く石までを数える
column_num = same_color_stone_column - cell_column - 1
row_num = same_color_stone_row - cell_row - 1
' 列数と行数が同じであることを確認
If column_num = row_num Then
' 同色の石があるところまで、石を同色に変える
For n = 1 To column_num
Cells(cell_row + n, cell_column + n).Value = stone
Next
End If
End If
End Sub
' 石があるかどうか、左方向チェックの関数
Function left_change_check(cell_row, cell_column, stone, reverse_stone)
Dim check_result As Boolean
check_result = False
' 石を置く場所が盤の左から3マス目より大きいことを確認
If cell_column - 2 >= LEFT_TOP_COLUMN Then
' 置かれている石が置こうとしている石の逆の石であることを確認
If Cells(cell_row, cell_column - 1).Value = reverse_stone Then
' すぐ横の石の、その横の石から見ていくため
i = cell_column - 2
' 盤の終わりまで左側のセルを見ていく
Do While i >= LEFT_TOP_COLUMN
' 石がない場合はループを抜ける
If Cells(cell_row, i).Value = "" Then
Exit Do
End If
' 同色の石があるかどうか確認
If Cells(cell_row, i).Value = stone Then
check_result = True
Exit Do
End If
i = i - 1
Loop
End If
End If
left_change_check = check_result
End Function
' 石があるかどうか、右方向チェックの関数
Function right_change_check(cell_row, cell_column, stone, reverse_stone)
Dim check_result As Boolean
check_result = False
' 石を置く場所が盤の右から3マス目より小さいことを確認
If cell_column + 2 <= LEFT_TOP_COLUMN + 8 Then
' 置かれている石が置こうとしている石の逆の石であることを確認
If Cells(cell_row, cell_column + 1).Value = reverse_stone Then
' すぐ横の石の、その横の石から見ていくため
i = cell_column + 2
' 盤の終わりまで右側セルを見ていく
Do While i <= LEFT_TOP_COLUMN + 8
' 石がない場合はループを抜ける
If Cells(cell_row, i).Value = "" Then
Exit Do
End If
' 同色の石があるかどうか確認
If Cells(cell_row, i).Value = stone Then
check_result = True
Exit Do
End If
i = i + 1
Loop
End If
End If
right_change_check = check_result
End Function
' 石があるかどうか、上方向チェックの関数
Function up_change_check(cell_row, cell_column, stone, reverse_stone)
Dim check_result As Boolean
check_result = False
' 石を置く場所が盤の上から3マス目より大きいことを確認
If cell_row - 2 >= LEFT_TOP_LOW Then
' 置かれている石が置こうとしている石の逆の石であることを確認
If Cells(cell_row - 1, cell_column).Value = reverse_stone Then
' すぐ上の石の、その上の石から見ていくため
i = cell_row - 2
' 盤の終わりまで上側セルを見ていく
Do While i >= LEFT_TOP_LOW
' 石がない場合はループを抜ける
If Cells(i, cell_column).Value = "" Then
Exit Do
End If
' 同色の石があるかどうか確認
If Cells(i, cell_column).Value = stone Then
check_result = True
Exit Do
End If
i = i - 1
Loop
End If
End If
up_change_check = check_result
End Function
' 石があるかどうか、下方向チェックの関数
Function down_change_check(cell_row, cell_column, stone, reverse_stone)
Dim check_result As Boolean
check_result = False
' 石を置く場所が盤の下から3マス目より小さいことを確認
If cell_row + 2 <= LEFT_TOP_LOW + 8 Then
' 置かれている石が置こうとしている石の逆の石であることを確認
If Cells(cell_row + 1, cell_column).Value = reverse_stone Then
' すぐ下の石の、その下の石から見ていくため
i = cell_row + 2
' 盤の終わりまで下側セルを見ていく
Do While i <= LEFT_TOP_LOW + 8
' 石がない場合はループを抜ける
If Cells(i, cell_column).Value = "" Then
Exit Do
End If
' 同色の石があるかどうか確認
If Cells(i, cell_column).Value = stone Then
check_result = True
Exit Do
End If
i = i + 1
Loop
End If
End If
down_change_check = check_result
End Function
' 石があるかどうか、左上方向チェックの関数
Function left_up_change_check(cell_row, cell_column, stone, reverse_stone)
Dim check_result As Boolean
check_result = False
' 左上から縦方向と横方向ともに2マス以上離れていることを確認
If cell_column - 2 >= LEFT_TOP_COLUMN And cell_row - 2 >= LEFT_TOP_ROW Then
' 左上の石が置いた石と反対の石であることを確認
If Cells(cell_row - 1, cell_column - 1).Value = reverse_stone Then
' すぐ左上の石の、その左上の石から見ていくため
i = cell_column - 2
j = cell_row - 2
' 盤の左上の座標よりも大きい場合は、処理を続ける
Do While i >= LEFT_TOP_COLUMN And j >= LEFT_TOP_ROW
' 石がない場合はループを抜ける
If Cells(j, i).Value = "" Then
Exit Do
End If
' 同色の石があるかどうか確認
If Cells(j, i).Value = stone Then
check_result = True
Exit Do
End If
i = i - 1
j = j - 1
Loop
End If
End If
left_up_change_check = check_result
End Function
' 石があるかどうか、左下方向チェックの関数
Function left_down_change_check(cell_row, cell_column, stone, reverse_stone)
Dim check_result As Boolean
check_result = False
' 左下から縦方向と横方向ともに2マス以上離れていることを確認
If cell_column - 2 >= LEFT_TOP_COLUMN And cell_row + 2 <= LEFT_TOP_ROW + 7 Then
' 左下の石が置いた石と反対の石であることを確認
If Cells(cell_row + 1, cell_column - 1).Value = reverse_stone Then
' すぐ左下の石の、その左下の石から見ていくため
i = cell_column - 2
j = cell_row + 2
' 盤の左下の座標よりも小さい場合は、処理を続ける
Do While i >= LEFT_TOP_COLUMN And j <= LEFT_TOP_ROW + 7
' 石がない場合はループを抜ける
If Cells(j, i).Value = "" Then
Exit Do
End If
' 同色の石があるかどうか確認
If Cells(j, i).Value = stone Then
check_result = True
Exit Do
End If
i = i - 1
j = j + 1
Loop
End If
End If
left_down_change_check = check_result
End Function
' 石あるかどうか、右上方向チェックの関数
Function right_up_change_check(cell_row, cell_column, stone, reverse_stone)
Dim check_result As Boolean
check_result = False
' 右上から縦方向と横方向ともに2マス以上離れていることを確認
If cell_column + 2 <= LEFT_TOP_COLUMN + 7 And cell_row - 2 >= LEFT_TOP_ROW Then
' 右上の石が置いた石と反対の石であることを確認
If Cells(cell_row - 1, cell_column + 1).Value = reverse_stone Then
' すぐ右上の石の、その右上の石から見ていくため
i = cell_column + 2
j = cell_row - 2
' 盤の右上の座標よりも小さい場合は、処理を続ける
Do While i <= LEFT_TOP_COLUMN + 7 And j >= LEFT_TOP_ROW
' 石がない場合はループを抜ける
If Cells(j, i).Value = "" Then
Exit Do
End If
' 同色の石があるかどうか確認
If Cells(j, i).Value = stone Then
check_result = True
Exit Do
End If
i = i + 1
j = j - 1
Loop
End If
End If
right_up_change_check = check_result
End Function
' 石あるかどうか、右下方向チェックの関数
Function right_down_change_check(cell_row, cell_column, stone, reverse_stone)
Dim check_result As Boolean
check_result = False
' 右下から縦方向と横方向ともに2マス以上離れていることを確認
If cell_column + 2 <= LEFT_TOP_COLUMN + 7 And cell_row + 2 <= LEFT_TOP_ROW + 7 Then
' 右下の石が置いた石と反対の石であることを確認
If Cells(cell_row + 1, cell_column + 1).Value = reverse_stone Then
' すぐ右下の石の、その右下の石から見ていくため
i = cell_column + 2
j = cell_row + 2
' 盤の右下の座標よりも小さい場合は、処理を続ける
Do While i <= LEFT_TOP_COLUMN + 7 And j <= LEFT_TOP_ROW + 7
' 石がない場合はループを抜ける
If Cells(j, i).Value = "" Then
Exit Do
End If
' 同色の石があるかどうか確認
If Cells(j, i).Value = stone Then
check_result = True
Exit Do
End If
i = i + 1
j = j + 1
Loop
End If
End If
right_down_change_check = check_result
End Function
完成したものはこのようになります。
参考サイト
以下サイト内のリンクからそれぞれの記事への遷移ができないため、
すべての記事をここに貼りました。
さいごに
今回はVBAでオセロを作成して学んだことをアウトプットしました。
まだバグの修正はできておりませんが、石を裏返す処理、黒と白どちらの番か、
それぞれの石の枚数の表示の実装をじぶんで考えたことは、かなり勉強になりました。
また、Macだと参考記事どおりのやり方ではうまくいかないことがあり、
詰まる場面が多々ありました。
たとえば、コメントで日本語を修正する際、カーソルの位置が合わなかったり、
かな入力できなくなることがありましたが、他のエクセルシート内でかな入力してから
再度おこなうと解消しました。
あと、実装内容の反映が遅いことがあるので、その際は①ソース内容に誤りがないか再確認、
②保存漏れ確認、③エクセル再起動のように対処しておりました。
最後まで目を通していただきありがとうございました。
私の記録が誰かの役に立つと嬉しいです。。