Excelを使ったゲームのつくり方！Excelで動くオセロ～コピペで使えるExcelマクロ～
Excelマクロ（Excel VBA）を使えば、単なる表計算ソフトとしてだけではなく、簡単なゲームやインタラクティブなアプリケーションを作成することができます。今回ご紹介するコードは、Excel上で動く簡単なオセロを再現するものです。
動画はこちらからどうぞ
Excelマクロの基本的な使い方は、下の記事を参考にしてください
1. マクロの概要
今回紹介するコードは、Excelシート上に8×8の盤面を作成し、オセロ（リバーシ）のルールに基づいてプレイヤー（人）とコンピュータが交互に石を置いていく仕組みになっています。主な特徴は以下のとおりです。
グローバル変数と定数
盤面を表す配列や、人・コンピュータの石を区別するための定数が定義されています。初期化・描画機能
ゲーム開始時に盤面を初期状態にセットし、Excelシート上に描画します。中央に4つの石が配置される標準的なオセロの初期配置を採用しています。判定と手番処理
ユーザーが選んだセルに石を置けるかどうかを判定する機能や、置いた場合に挟んだ相手の石を裏返すロジックが組まれています。また、コンピュータは裏返せる石の数が最も多い場所を選んで自動で手を打ちます。ゲーム終了の判定
両者ともに有効な手がなくなった場合、最終スコアを計算し、勝敗を表示します。
2. コードの説明
以下が今回紹介するVBAコードです。ExcelのVBAエディタに貼り付けて使います。
Option Explicit
' 定数の定義
Public Const NO_STONE As Integer = 0
Public Const HUMAN As Integer = 1 ' 人（黒い石 ※表示は●）
Public Const COMPUTER As Integer = 2 ' コンピュータ（白い石 ※表示は○）
' 8×8の盤面を表すグローバル配列（行1～8、列1～8）
Public board(1 To 8, 1 To 8) As Integer
' ********************
' 【初期化・描画関連】
' ********************
' ゲーム開始（盤面の初期化と描画）
Sub StartGame()
Dim i As Integer, j As Integer
' 盤面をクリア（全セル NO_STONE）
For i = 1 To 8
For j = 1 To 8
board(i, j) = NO_STONE
Next j
Next i
' オセロの初期配置 ※標準ルールでは中央の4マスに石を配置
board(4, 4) = COMPUTER
board(5, 5) = COMPUTER
board(4, 5) = HUMAN
board(5, 4) = HUMAN
' 盤面を描画（シート名「Othello」上のセル B2:I9 を使用）
DrawBoard
MsgBox "ゲーム開始！あなたのターンです。" & vbCrLf & _
"※盤面上のセル（B2～I9）を選択して 駒を置くボタンを押してください"
End Sub
Sub DrawBoard()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Othello")
Dim i As Integer, j As Integer
Dim cell As Range
' セル B2:I9 に盤面を描画（行 i → セル行は i+1、列 j → セル列は j+1）
For i = 1 To 8
For j = 1 To 8
Set cell = ws.Cells(i + 1, j + 1)
cell.Clear
cell.Interior.Color = RGB(0, 128, 0) ' 緑色（盤面カラー）
cell.HorizontalAlignment = xlCenter
cell.VerticalAlignment = xlCenter
cell.Font.Bold = True
cell.Font.Size = 16
Select Case board(i, j)
Case HUMAN
cell.Value = "●" ' 人の石（黒）
cell.Font.Color = vbBlack
Case COMPUTER
cell.Value = "○" ' コンピュータの石（白）
cell.Font.Color = vbWhite
Case NO_STONE
cell.Value = ""
End Select
Next j
Next i
' 枠線を引く（盤面部分）
ws.Range(ws.Cells(2, 2), ws.Cells(9, 9)).Borders.LineStyle = xlContinuous
' ここから駒の数をカウントして、空いているセルに表示する処理です
Dim humanCount As Integer, compCount As Integer
humanCount = 0
compCount = 0
For i = 1 To 8
For j = 1 To 8
If board(i, j) = HUMAN Then
humanCount = humanCount + 1
ElseIf board(i, j) = COMPUTER Then
compCount = compCount + 1
End If
Next j
Next i
' 例としてセル K2 に「あなたの駒」、K3 に「コンピュータの駒」の数を表示
ws.Range("K2").Value = "あなたの駒: " & humanCount
ws.Range("K3").Value = "コンピュータの駒: " & compCount
End Sub
' ********************
' 【判定・手番処理関連】
' ********************
' 指定したプレイヤーが (r, c) に置けるかどうか判定する
Function IsValidMove(player As Integer, r As Integer, c As Integer) As Boolean
Dim opponent As Integer
If player = HUMAN Then
opponent = COMPUTER
Else
opponent = HUMAN
End If
' 既に石がある場合は不可
If board(r, c) <> NO_STONE Then
IsValidMove = False
Exit Function
End If
Dim dr As Integer, dc As Integer
Dim i As Integer, j As Integer
Dim foundOpponent As Boolean
' 8方向（上下左右＋斜め）をチェック
For dr = -1 To 1
For dc = -1 To 1
If Not (dr = 0 And dc = 0) Then
i = r + dr
j = c + dc
foundOpponent = False
Do While i >= 1 And i <= 8 And j >= 1 And j <= 8
If board(i, j) = opponent Then
foundOpponent = True
ElseIf board(i, j) = player Then
If foundOpponent Then
IsValidMove = True
Exit Function
Else
Exit Do
End If
Else ' NO_STONE
Exit Do
End If
i = i + dr
j = j + dc
Loop
End If
Next dc
Next dr
IsValidMove = False
End Function
' 指定したプレイヤーが (r, c) に置いたときに裏返す石の総数を返す（コンピュータの評価用）
Function CountFlips(player As Integer, r As Integer, c As Integer) As Integer
Dim opponent As Integer
If player = HUMAN Then
opponent = COMPUTER
Else
opponent = HUMAN
End If
Dim flips As Integer
flips = 0
Dim dr As Integer, dc As Integer
Dim i As Integer, j As Integer
Dim count As Integer
For dr = -1 To 1
For dc = -1 To 1
If Not (dr = 0 And dc = 0) Then
i = r + dr
j = c + dc
count = 0
Do While i >= 1 And i <= 8 And j >= 1 And j <= 8
If board(i, j) = opponent Then
count = count + 1
ElseIf board(i, j) = player Then
If count > 0 Then
flips = flips + count
End If
Exit Do
Else
Exit Do
End If
i = i + dr
j = j + dc
Loop
End If
Next dc
Next dr
CountFlips = flips
End Function
' (r, c) にプレイヤーの石を置き、裏返す処理を行う
Sub MakeMove(player As Integer, r As Integer, c As Integer)
board(r, c) = player
Dim opponent As Integer
If player = HUMAN Then
opponent = COMPUTER
Else
opponent = HUMAN
End If
Dim dr As Integer, dc As Integer
Dim i As Integer, j As Integer
Dim tempList As Collection
Dim cellPos As Variant
' 8方向に対して、相手石が連続しているか確認し、挟める場合は裏返す
For dr = -1 To 1
For dc = -1 To 1
If Not (dr = 0 And dc = 0) Then
i = r + dr
j = c + dc
Set tempList = New Collection
Do While i >= 1 And i <= 8 And j >= 1 And j <= 8
If board(i, j) = opponent Then
tempList.Add Array(i, j)
ElseIf board(i, j) = player Then
If tempList.count > 0 Then
Dim k As Integer
For k = 1 To tempList.count
cellPos = tempList.Item(k)
board(cellPos(0), cellPos(1)) = player
Next k
End If
Exit Do
Else
Exit Do
End If
i = i + dr
j = j + dc
Loop
End If
Next dc
Next dr
DrawBoard
End Sub
' 指定プレイヤーがどこかに置けるかどうか判定する
Function HasValidMove(player As Integer) As Boolean
Dim r As Integer, c As Integer
For r = 1 To 8
For c = 1 To 8
If IsValidMove(player, r, c) Then
HasValidMove = True
Exit Function
End If
Next c
Next r
HasValidMove = False
End Function
' 両者とも置く場所がなければゲーム終了。最終スコアと勝敗を表示する
Sub CheckGameEnd()
If Not HasValidMove(HUMAN) And Not HasValidMove(COMPUTER) Then
Dim humanCount As Integer, compCount As Integer
humanCount = 0
compCount = 0
Dim r As Integer, c As Integer
For r = 1 To 8
For c = 1 To 8
If board(r, c) = HUMAN Then
humanCount = humanCount + 1
ElseIf board(r, c) = COMPUTER Then
compCount = compCount + 1
End If
Next c
Next r
Dim resultMsg As String
resultMsg = "ゲーム終了！" & vbCrLf & _
"あなたの石: " & humanCount & vbCrLf & _
"コンピュータの石: " & compCount & vbCrLf
If humanCount > compCount Then
resultMsg = resultMsg & "あなたの勝ちです！"
ElseIf compCount > humanCount Then
resultMsg = resultMsg & "コンピュータの勝ちです！"
Else
resultMsg = resultMsg & "引き分けです！"
End If
MsgBox resultMsg
Exit Sub
End If
End Sub
' ********************
' 【手番処理】
' ********************
' 人の手番：アクティブセルを元に、ユーザーが置きたい場所に石を置く
Sub HumanTurn()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Othello")
Dim sel As Range
Set sel = Application.ActiveCell
' 盤面のセル範囲は B2～I9 に対応
If sel.Row < 2 Or sel.Row > 9 Or sel.Column < 2 Or sel.Column > 9 Then
MsgBox "盤面上（B2～I9）のセルを選択してください。"
Exit Sub
End If
Dim r As Integer, c As Integer
r = sel.Row - 1 ' 例：B2 → r=1
c = sel.Column - 1
If Not IsValidMove(HUMAN, r, c) Then
MsgBox "その場所には置けません。"
Exit Sub
End If
' 人の手を実行
MakeMove HUMAN, r, c
' ゲーム終了チェック
CheckGameEnd
' コンピュータに置く場所がなければターンをスキップする
If Not HasValidMove(COMPUTER) And HasValidMove(HUMAN) Then
MsgBox "コンピュータは置く場所がありません。あなたのターンです。"
Exit Sub
End If
' コンピュータの手番（置ける場合）
If HasValidMove(COMPUTER) Then
ComputerTurn
End If
' 再度ゲーム終了チェック
CheckGameEnd
' 人の手番がなくなっている場合は、ターンをスキップしてコンピュータの手番
If Not HasValidMove(HUMAN) And HasValidMove(COMPUTER) Then
MsgBox "あなたは置く場所がありません。コンピュータのターンです。"
ComputerTurn
CheckGameEnd
End If
MsgBox "あなたのターンです。盤面上のセルを選択して HumanTurn マクロを実行してください。"
End Sub
' コンピュータの手番：有効な手の中から裏返せる石の数が最大の場所を選択して置く
Sub ComputerTurn()
Dim moveFound As Boolean
moveFound = False
Dim r As Integer, c As Integer
Dim bestR As Integer, bestC As Integer
Dim bestScore As Integer
bestScore = -1
Dim score As Integer
' 盤面全体を走査して、最も裏返せる数が多い手を選択
For r = 1 To 8
For c = 1 To 8
If IsValidMove(COMPUTER, r, c) Then
score = CountFlips(COMPUTER, r, c)
If score > bestScore Then
bestScore = score
bestR = r
bestC = c
moveFound = True
End If
End If
Next c
Next r
If moveFound Then
' わかりやすいように1秒待機
Application.Wait Now + TimeValue("00:00:01")
MakeMove COMPUTER, bestR, bestC
MsgBox "コンピュータは (" & bestR & ", " & bestC & ") に置きました。"
Else
MsgBox "コンピュータは置く場所がありません。ターンをスキップします。"
End If
End Sub
定数とグローバル変数
定数の定義
Public Const NO_STONE As Integer = 0
Public Const HUMAN As Integer = 1
Public Const COMPUTER As Integer = 2盤面配列
Public board(1 To 8, 1 To 8) As Integer8×8の盤面全体を管理するための配列です。
初期化と描画
StartGameマクロ
ゲーム開始時に盤面をクリアし、中央に初期配置の石を置いた後、DrawBoardマクロで盤面をExcelシート上に描画します。
Sub StartGame()
' 盤面をクリアし、初期配置をセット
' DrawBoardでシート上に表示
MsgBox "ゲーム開始！あなたのターンです。"
End SubDrawBoardマクロ
Excelの「Othello」シート上のセル（B2～I9）を使って盤面を描画。石の色や配置、さらに石の数をセルK2・K3に表示します。
判定・手番処理
IsValidMove関数
指定したセルに石を置けるか、8方向すべてをチェックして判定します。CountFlips関数
指定の位置に置いた場合に裏返せる相手の石の数を数え、コンピュータの戦略評価に使用します。MakeMoveサブ
実際に石を置き、相手の石を裏返す処理を行います。配置後はDrawBoardで盤面を再描画します。HumanTurn・ComputerTurnサブ
ユーザーの入力（アクティブセル）に基づいて石を置く処理と、コンピュータが最適な手を自動で選択する処理が含まれています。
コンピュータは、裏返せる石の数が最も多い手を選ぶシンプルな戦略です。CheckGameEndサブ
両者ともに置ける場所がなくなったときにゲーム終了とし、最終スコアと勝敗結果を表示します。
3. 使い方
準備
Excelファイルを開く
まず、VBAコードが組み込まれたExcelファイル（拡張子 .xlsm）を開いてください。シートの確認
シート名「Othello」が存在し、盤面描画用のセル範囲（B2～I9）や、スコア表示用のセル（K2, K3）が正しく配置されているか確認しましょう。
ゲームの開始
StartGameマクロの実行
VBAエディターまたはExcelの「マクロ」メニューからStartGameマクロを実行します。
→ 盤面が初期化され、中央に初期配置の石が置かれ、ゲーム開始のメッセージが表示されます。セルの選択と石を置く
ゲーム中は、盤面上のセル（B2～I9）をクリックしてアクティブセルにし、HumanTurnマクロ（または対応するボタン）を実行することで、自分の手を打ちます。
→ 選んだ場所に石が置けない場合は、エラーメッセージが表示されます。コンピュータの手番
人の手が完了すると、自動的にコンピュータが最適な場所に石を置きます。石が置かれると、盤面が更新され、挟んだ相手の石が裏返されます。ゲーム終了
両者ともに置ける場所がなくなると、最終スコアが計算され、勝敗が表示されます。
4. まとめ
今回はExcel VBAのオセロについてご紹介しました。
Excel VBAでのゲーム作成に興味がある方は、ぜひこのコードを手本に、自分なりのアレンジを加えてみてください。
※本記事で紹介しているマクロやファイルの使用に伴い発生したいかなるトラブルや損害についても、当方では一切の責任を負いかねます。すべて自己責任のもとでご利用ください。
5. ファイルの配布（有償or宣伝で割引あり）
コードは、ExcelのVBAエディタに貼り付けるだけで動作するようになっておりますが、実際の動作ファイルが必要な方のために、有料または、宣伝していただくことで無料配布しております。なお、以下の点についてご理解いただいた上でご購入ください。
動作保証について
Excelという環境上での実装となっているため、動作が非常に重かったり、PCのスペックやExcelのVersionによっては正常に動作しない可能性があります。ゲームとしての完成度や快適さは保証できませんので、あくまでExcel VBAの教材的な扱いとしてご検討ください。返金・トラブル対応について
万が一不具合やトラブルが発生した場合でも、動作の保証は致しかねます。Noteの返金設定は有効にしております。返金処理に関しては、Noteの規約に全て従うという点を予めご了承ください。
また、購入して頂いた方向けに、補足情報もやパラメータの変更方法も紹介しております。
ここから先は
この記事が気に入ったらチップで応援してみませんか？