はじめに
どーも 暇人プログラマーTakeです。
今回も暇すぎて、Excel でトランプを使った「神経衰弱」を作ってみました！！
作成時間はおよそ３時間くらいでした！
わたしは要領が悪いので、作成に結構時間がかかってしまいました。。。
たぶんプログラミングが得意な人はもっと早くできると思います。
この記事では、私が作成した「神経衰弱」の操作方法と作成方法についてご紹介します～！
操作方法
操作方法は下記手順です。
- 数字の種類（２～１３）を設定します
- マークの種類（♥ ♠ ♦ ♣）を設定します。
- 「START」押下します。すると、「ステータス」がゲーム中に変更されます。
- セル上に赤いセルがでてきますので、どれかを二枚押します。
- 二枚同じ数字ならカードの表示が消え、獲得枚数が追加されます。
- 全部カードの表示が消えれば、ゲーム終了です。
簡単に言うと、設定することして、ボタンを押下すれば、
あとは普通の「神経衰弱」です。
数字の種類（２～１３）
ゲームに使うトランプの数字の種類のことを指します。
たとえば、数字の種類（２～１３）＝ 3 と設定すれば、
トランプの数字（2 ~10、J、Q、K）のうち3種類の数字（たとえば、２、４、Jの3種類）
を使うように設定するということです（この数値はランダムで決定します）。
マークの種類（♥ ♠ ♦ ♣）
ゲームに使うトランプのマークの種類のことです。
これは、「2」か「4」のみ設定できるのですが、
「2」と設定すると、♥ ♠の2種類、「4」と設定すると、♥ ♠ ♦ ♣の4種類が
神経衰弱のゲーム内で使用されるということです。
配置されるカードの枚数について
また配置されるカードの枚数ですが、
数字の種類（２～１３）×記号の種類（♥ ♠ ♦ ♣）の枚数になります。
つまり、最大が１3×4枚＝52 枚となります。
「START」と「FIN」ボタンについて
「START」ボタンを押下することで、ゲームが開始されます。
その際に「ステータス」という箇所が「ゲーム中」に変更されるのが確認できます。
また、トランプが表示されることが確認でき、押下も可能です（画面赤色のセルの箇所）。
「FIN」ボタンを押下することで、ゲームが終了します。
その際に「ステータス」という箇所が「ゲーム終了」に変更されるのが確認できます。
なお「ゲーム終了」状態では、カードを押下しても反応しなくなります。
作成方法
今回は、Excel Vba を用いて作成しました！
作成方法について、全部記述すると長くなるのですがご容赦ください。
※ 専門的な用語もでてきますので、よくわかない方は、ページの一番下のダウンロードボタンから
Excel「神経衰弱」をダウンロードして遊んでみてください！
シート構成
- 神経衰弱
- トランプマスタ（非表示シート）
- 作業用
「神経衰弱」はメインシートであるので、実施に神経衰弱を行う用のシートとなります。
実装自体は Excel Vba で行っており、このシートはその実装結果を表示させているだけです。
「トランプマスタ」はトランプに関する情報を登録するシートです。
具体的には、トランプで使用する数字とマークをどういうものを使用するかといったことを登録しています。
この値を参照してトランプとして扱う数字とマークを設定するように Excel Vba 上で動作させています。
作業用シートは実際に神経衰弱のゲームを行っていく上で必要な情報を登録するシートです。
具体的には下記情報を登録しています。
- マウスからクリックされたカードの情報（カードの値とカードのセルの位置）
- クリックされた二枚のカードが同じ数字のカードであるか判定
- 全カード枚数、残り枚数、獲得枚数
- ゲームステータス（ゲーム中か終了か）
ソースコード
Excel Vba のソースコードについては下記のような構成になっています。
- Sheet1(神経衰弱)
- STARTボタン押下処理
- カード押下時の処理
- ゲーム終了処理
- 定数定義
- 配置カードを設定
- 盤上へカードを配置
Sheet1(神経衰弱)
ここはシート上のクリックを検知し、その検知した結果、さまざまな処理を行う箇所です。
具体的には、カードを配置する範囲のセルがクリックされている状態で
かつステータスが「ゲーム中」の場合にクリックが検知された場合に様々な処理を行うようにしています。
- カード押下前の処理
- カード押下時の処理
- カード押下後の処理
- カード終了時のフラグ
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
'シート操作の処理 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim NowCell Set NowCell = ActiveCell Dim GameStatus GameStatus = Worksheets(WORK_SHEET).Range(GAME_STATUS_PLACE).Value If GameStatus = MSG_GAME_START _ And BOARD_Y <= NowCell.Row And NowCell.Row <= BOARD_Y + 8 _ And BOARD_X <= NowCell.Column And NowCell.Column <= BOARD_X + 20 _ And NowCell.Value <> "" _ Then ' カード押下前の処理 Call prepareCard(NowCell, NowCell.Address) ' カード押下時の処理 Call openCard(NowCell) ' カード押下後の処理 Call pushCard(NowCell.Value, NowCell.Address) 'カード終了時のフラグ Call finGame End If End Sub |
※ Excel シートのクリック検知について記事を以前記事を作成しましたの、よければ参考にご確認ください。
（わたしは以前これを知らなくてめちゃくちゃ悩んだ覚えがありますが、知っていれば超簡単です！）
STARTボタン押下処理
ここでは、START ボタンが押下された場合の処理をまとめています。
私が作成したマクロは、STARTボタンを押下することでゲームが開始する仕様になっていますが、
ゲーム開始前の準備をここでは行うということです。
- メインシート 初期化
- 作業用シート 初期化
- 盤上にカードをセット
- ゲームステータスの設定
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
' START ボタン押下処理 Sub main() Application.ScreenUpdating = False Dim numArray ' メインシート 初期化 Call setDefaultMainSheet ' メインシート 初期化 Call setDefaultWorkSheet ' 配置するカードを設定 numArray = setCard ' 盤上にカードをセット Call setBorad(numArray) ' ゲームステータス Worksheets(WORK_SHEET).Range(GAME_STATUS_PLACE).Value = MSG_GAME_START Application.ScreenUpdating = True End Sub ' メインシート 初期化 Sub setDefaultMainSheet() With Worksheets(MAIN_SHEET) .Range(Cells(BOARD_Y, X + BOARD_X), Cells(BOARD_Y + 20, X + BOARD_X + 20)).Clear End With End Sub ' 作業用シート 初期化 Sub setDefaultWorkSheet() With Worksheets(WORK_SHEET) .Range(FIRST_INFO_PLACE).ClearContents .Range(SECOND_INFO_PLACE).ClearContents .Range(FIRST_CELL_PLACE).ClearContents .Range(SECOND_CELL_PLACE).ClearContents End With End Sub |
カード押下時の処理
シート上の赤いセルをクリックした場合に実装される処理です。
Sheet1(神経衰弱)で動作を検知し、このソースコードに書かれたプロシージャが実行されるということです。
- カード押下前の処理
- カード押下時の処理
- カード押下後の処理
カード押下前の処理
ここでは、まず一枚目と二枚目のカードが押下されたセルの情報（セルの値とセルの位置）を
「作業用シート」に記述します。
カード押下時の処理
押下されたセルの配色を変更します。
赤色のカードとは、つまり赤色の背景色のセル（セル内の文字も赤色）ということですが、
カードが押下されたということが、カードを開く（表返す）ためにセルの背景色を赤色から白色に変更しています。
また、この際に、♥と♦のマークを赤色、♠と♣を黒色にするように表示します。
（下記はかなり悩んだところなんですが。。。）
Excel Vbaでは、 ♥♠♦♣という文字が読み取れません。
読み取ろうとすると「?」となってしまいます（Excel 2016ではそうなりました。。）。
ですので、今回の対策として、
- Excel Vbaで値としては、♥♠♦♣ではなく別の文字に置き換える（「H」「S」「D」「C」のように）
- 表示の前に「作業用」シートに置き換える前の値を記述しておく
- 表示させるときのみ♥♠♦♣に置き換える（VLookup関数をつかって「トランプマスタ」シートから参照）
- カードを裏返すときに、置き換える前の文字を入力するようにする
カード押下後の処理
ここでは、カードが二枚クリックされたかを判定し、
判定した結果、同じ数字であるかそうでないかを比較し、同じならカードを削除します。
判定方法は、「作業用シート」のB2、C2の値が両方空白かどうかで判定します。
両方とも値が含まれていれば、二枚クリックされたということです。
数字の比較については、「作業用シート」のB2、C2の値を比較しますが、
このときカードのマーク無視するようにします（つまり一番最後の文字を無視して数字部分のみ判定します）。
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 |
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long) ' カード押下前の処理 Sub prepareCard(ByVal CardInfo, ByVal CardAddress) Dim firstCard Dim secondCard Dim firstPlace Dim secondPlace firstCard = Worksheets(WORK_SHEET).Range(FIRST_INFO_PLACE).Value secondCard = Worksheets(WORK_SHEET).Range(SECOND_INFO_PLACE).Value ' 1枚目が押下されたとき If firstCard = "" Then Worksheets(WORK_SHEET).Range(FIRST_INFO_PLACE).Value = CardInfo Worksheets(WORK_SHEET).Range(FIRST_CELL_PLACE).Value = CardAddress ' 2枚目が押下されたとき ElseIf secondCard = "" Then Worksheets(WORK_SHEET).Range(SECOND_INFO_PLACE).Value = CardInfo Worksheets(WORK_SHEET).Range(SECOND_CELL_PLACE).Value = CardAddress End If End Sub ' カード押下時の処理 Sub openCard(ByRef CellValue) Dim inputValue Dim cardValueLast inputValue = ouputVlookup(CellValue) cardValueLast = Right(CellValue, 1) With CellValue .Value = inputValue .Borders.LineStyle = xlContinuous .Borders.Color = RGB(255, 0, 0) .Interior.ColorIndex = CARD_COLOR_WHITE If cardValueLast = "H" Or cardValueLast = "D" Then .Font.ColorIndex = CARD_COLOR_RED Else .Font.ColorIndex = CARD_COLOR_BLACK End If End With End Sub ' カード押下後の処理 Sub pushCard(ByVal CardInfo, ByVal CardAddress) Dim firstCard Dim secondCard Dim firstPlace Dim secondPlace firstCard = Worksheets(WORK_SHEET).Range(FIRST_INFO_PLACE).Value secondCard = Worksheets(WORK_SHEET).Range(SECOND_INFO_PLACE).Value firstPlace = Worksheets(WORK_SHEET).Range(FIRST_CELL_PLACE).Value secondPlace = Worksheets(WORK_SHEET).Range(SECOND_CELL_PLACE).Value ' 1枚目が押下されたとき If secondCard <> "" Then Sleep WAIT_TIME ' カードが同じとき If Worksheets(WORK_SHEET).Range(JUDGE_PLACE).Value = 1 _ And firstPlace <> secondPlace _ Then Call deleteCard(firstPlace) Call deleteCard(secondPlace) ' カードが違うとき Else Call backCard(firstPlace, firstCard) Call backCard(secondPlace, secondCard) End If ' 作業用シート 初期化 Call setDefaultWorkSheet End If End Sub ' 違うカードをもとに戻す（ひっくり返す） Private Sub backCard(ByVal CardPlace, ByVal CardValue) Application.ScreenUpdating = False With Worksheets(MAIN_SHEET).Range(CardPlace) .Value = CardValue .ColumnWidth = CARD_HEIGHT .RowHeight = CARD_WIDTH .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.ColorIndex = CARD_COLOR_RED .Interior.ColorIndex = CARD_COLOR_RED End With Application.ScreenUpdating = True End Sub ' 同じカードの場合削除する Private Sub deleteCard(ByVal CardPlace) With Worksheets(MAIN_SHEET).Range(CardPlace) .ClearContents .ColumnWidth = CARD_HEIGHT .RowHeight = CARD_WIDTH .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.ColorIndex = CARD_COLOR_WHITE .Interior.ColorIndex = CARD_COLOR_WHITE End With End Sub |
ゲーム終了処理
ここでは、ゲーム終了処理に関する処理が含まれます。
ゲームが終了するパターンは主に2通りです。
- 神経衰弱のカードがすべてめくられて終わるパターン
- 「FIN」ボタンが押下されて終了するパターン
①のすべてカードがめくられたときの検知方法ですが、
二枚目のカードがクリックされた後に
作業用シートの「残り枚数」と記載のある個所（F2）が０になったときに終了するように処理します。
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
'ゲーム終了処理 Sub finGame() Dim finFlag finFlag = Worksheets(WORK_SHEET).Range(REMAIN_CARD_NUM).Value If finFlag = 0 Then MsgBox MSG_FIN_GAME Worksheets(WORK_SHEET).Range(GAME_STATUS_PLACE).Value = MSG_GAME_END End If End Sub 'ゲーム終了押下 Sub pushFinGame() Worksheets(WORK_SHEET).Range(GAME_STATUS_PLACE).Value = MSG_GAME_END End Sub |
定数定義
ここでは、Excel Vba で扱う定数についてまとめて定義しています。
シート名、カードを配置する箇所（盤上という表現で記載）などなどです。
（たぶん、ソースコード見たほうがはやいとおもいます。）
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
' --- シート情報 --- Public Const MAIN_SHEET As String = "神経衰弱" Public Const MASTER_SHEET As String = "トランプマスタ" Public Const WORK_SHEET As String = "作業用" ' --- 「神経衰弱」シート --- ' データの範囲 盤上の設定 Public Const BOARD_X As Integer = 3 Public Const BOARD_Y As Integer = 6 Public Const SET_NUM_MAIN_RANGE As String = "F3" Public Const SET_KIGO_MAIN_RANGE As String = "L3" ' カード情報 Public Const CARD_HEIGHT As Integer = 5 Public Const CARD_WIDTH As Integer = 50 Public Const CARD_COLOR_RED As Integer = 3 Public Const CARD_COLOR_WHITE As Integer = 2 Public Const CARD_COLOR_BLACK As Integer = 1 ' --- 「トランプマスタ」シート --- Public Const MASTER_RANGE As String = "A2:B5" ' --- 「作業用」シート --- ' 残りカード枚数 Public Const REMAIN_CARD_NUM As String = "F2" ' 押下カードの情報 Public Const FIRST_INFO_PLACE As String = "B2" Public Const SECOND_INFO_PLACE As String = "C2" Public Const FIRST_CELL_PLACE As String = "B3" Public Const SECOND_CELL_PLACE As String = "C3" ' カードが一致するか Public Const JUDGE_PLACE As String = "D2" ' カードをもとに戻す時間 Public Const WAIT_TIME As Integer = 1000 ' ゲームステータス確認 Public Const GAME_STATUS_PLACE As String = "H2" ' --- その他 --- ' 判定フラグ Public Const PUSH_FIRST_CARD As Integer = 0 Public Const PUSH_SECOND_CARD_SAME As Integer = 1 Public Const PUSH_SECOND_CARD_DIFF As Integer = 2 ' --- メッセージ ---- ' ゲームステータス Public Const MSG_GAME_START As String = "ゲーム中" Public Const MSG_GAME_END As String = "ゲーム終了" ' ゲーム終了時 Public Const MSG_FIN_GAME As String = "お疲れ様でした！！ゲームを終了します！！" ' VLOOKUPの出力 Function ouputVlookup(ByVal Str) ouputVlookup = "=VLOOKUP(""" & Str & """,トランプマスタ!I:K,3,FALSE)" End Function |
配置カードを設定
ここでは「START」ボタン押下時にはじめにカードを配置する処理を記述しています。
大きくは setCard() プロシージャで処理を実装しています。
- 何種類の数字をゲームをするか、「神経衰弱」シートの数字とマークの種類から決定
- 上記の情報から、使用する数字を決定
- 最終的に使うカードの種類を決定し、配列に格納
ちょっとわかりにくかったかもなので、補足します。
はじめに「神経衰弱」シートで「３種類」の数字と「４種類」のマークを使用するとします。
つぎに「３種類」の数字の中からどの数字にするか（1 ~ 10の中で）ランダムに選択します。
たとえば、1、４、９と使うとすると
１、４、９ × 「４種類」のマーク♥♠♦♣ = 12種類の文字列を作成し、配列に格納します。
そして最終的に配列をランダムにシャッフルし、その配列をシートに出力するということです。
※ ここでは、配列の生成のみで、シートへの出力は別の「盤上へカードを配置」で行います。
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 |
' ゲームで使うカードの設定 ' 数字 + 記号を文字列を含む配列で返す Function setCard() As String() Dim numArray Dim allCardArray Dim setCardNumber As Integer ' 何種類の数字をゲームをするか setCardNumber = Worksheets(MAIN_SHEET).Range(SET_NUM_MAIN_RANGE) ' 上記の種類のランダム数字で決定 numArray = getCardArray(setCardNumber) ' 最終的に使うカードの種類を決定 setCard = decideCardArray(numArray) End Function ' 上記の種類のランダム数字で決定 Private Function getCardArray(ByRef Num As Integer) As String() Dim i As Long Dim myNum As Long Dim numArray() As String Dim myFlag(1 To 13) As Boolean '乱数系列を初期化 Randomize For i = 1 To Num Do myNum = Int((13 - 1 + 1) * Rnd + 1) Loop Until myFlag(myNum) = False ReDim Preserve numArray(i - 1) numArray(i - 1) = myNum myFlag(myNum) = True Next i getCardArray = numArray End Function ' 最終的に使うカードの種類を決定 Private Function decideCardArray(ByRef numArray) As String() Dim i As Integer: i = 0 Dim sumArray() As String Dim kigoMaster: kigoMaster = Worksheets(MASTER_SHEET).Range(MASTER_RANGE) Dim kigoNum: kigoNum = Worksheets(MAIN_SHEET).Range(SET_KIGO_MAIN_RANGE) For Each Var In numArray ReDim Preserve sumArray(i) sumArray(i) = Var & kigoMaster(1, 1) i = i + 1 ReDim Preserve sumArray(i) sumArray(i) = Var & kigoMaster(2, 1) i = i + 1 If kigoNum = 4 Then ReDim Preserve sumArray(i) sumArray(i) = Var & kigoMaster(3, 1) i = i + 1 ReDim Preserve sumArray(i) sumArray(i) = Var & kigoMaster(4, 1) i = i + 1 End If Next Var decideCardArray = cardShuffle(sumArray) End Function ' カードをシャッフル Private Function cardShuffle(ByRef cardArray) As String() For i = 0 To UBound(cardArray) Randomize rn = Int(UBound(cardArray) * Rnd) tmp = cardArray(i) cardArray(i) = cardArray(rn) cardArray(rn) = tmp Next cardShuffle = cardArray End Function |
盤上へカードを配置
「配置カードを設定」で生成した配列をシートに表示させます。
その表示の際に、カードの装飾も行っています。
カードの装飾とはつまりセルの配色を指します（たとえば、セルの値、罫線、背景色など）。
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
' 盤上へカードを配置 Sub setBorad(ByRef numArray) Dim X: X = 0 Dim Y: Y = 0 Dim j: j = 0 Dim arraylength: arraylength = UBound(numArray) + 1 Do ' カードの装飾 Call paintCard(numArray(j), X + BOARD_X, Y + BOARD_Y) If X >= 20 Then X = 0 Y = Y + 2 Else X = X + 2 End If arraylength = arraylength - 1 j = j + 1 Loop Until arraylength = 0 End Sub ' カードの装飾 Private Sub paintCard(ByVal CardValue, ByVal X, ByVal Y) With Worksheets(MAIN_SHEET).Cells(Y, X) .Value = CardValue .ColumnWidth = CARD_HEIGHT .RowHeight = CARD_WIDTH .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Orientation = xlVertical .Font.Bold = True .Font.ColorIndex = CARD_COLOR_RED .Interior.ColorIndex = CARD_COLOR_RED End With End Sub |
まとめ
いかがでしょうか？
Excel Vba があれば簡単に作れますでのよければぜひ作ってみてください！
※ 作成した Excel 「神経衰弱」は下記からダウンロードできます。よければぜひ遊んでみてください！
