陣取りゲーム

上のようなExcelを使った参加型ゲームを考えてみました。
実際に動かしてみようと思う方は標準モジュールに以下のプログラムをコピペしてください。

ＶＢＡって使ったことが無いという方はこちらを参考にしてみてください。
http://www.officepro.jp/excelvba/ini/index1.html
http://www.officepro.jp/excelvba/ini/index2.html

手順は、
①　画面作成コード（MakeSheet）を実行して画面を作る
②　できた画面に参加プレイヤーのデータを追加する
③　プログラムコード（GameStart）を実行してゲームスタート
　　プログラムコードを実行するときは、画面にスタートボタンをつけたり、ショートカットを登録するといいです。

画面作成コード

Sub MakeSheet()
    With Cells
        .RowHeight = 30
        .ColumnWidth = 4.5
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    With Range("A1:J10")
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeTop).Weight = xlThin
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
    End With
    Columns("M:S").ColumnWidth = 8
    Range("M1").Value = "名前"
    Range("N1").Value = "スタート"
    Range("O1").Value = "体力"
    Range("P1").Value = "攻撃力"
    Range("Q1").Value = "速さ"
    Range("R1").Value = "残体力"
    Range("S1").Value = "得点"
End Sub

プログラムコード

Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private turn As Integer

Private Type Player
    Color As Integer
    Name As String
    Range As Range
    Muki As String
    HP As Integer
    AP As Integer
    SP As Integer
    Point As Integer
    TP As Integer
End Type

Private Const MaxTurn As Integer = 1000         'ターン数
Private Const sleepTime As Integer = 50         '少なくすると処理が早くなります。

Private p(99) As Player
Private pc As Integer                           'プレイヤー数

Sub GameStart()
    Dim i As Integer
        
    Range("A1:J10").ClearContents
    Range("A1:J10").Interior.ColorIndex = xlNone

    pc = 0
    While Cells(pc + 2, 13).Value <> ""
        p(pc).Color = pc + 3
        Cells(pc + 2, 12).Value = "○"
        Cells(pc + 2, 12).Interior.ColorIndex = pc + 3
        p(pc).Name = Cells(pc + 2, 13).Value
        Select Case pc Mod 4
            Case 0
                p(pc).Muki = "U"
            Case 1
                p(pc).Muki = "R"
            Case 2
                p(pc).Muki = "D"
            Case 3
                p(pc).Muki = "L"
        End Select
        Set p(pc).Range = Range(Cells(pc + 2, 14).Value)
        p(pc).HP = Cells(pc + 2, 15).Value
        p(pc).AP = Cells(pc + 2, 16).Value
        p(pc).SP = Cells(pc + 2, 17).Value
        p(pc).Point = 1
        p(pc).TP = 0
        p(pc).Range.Value = "○"
        p(pc).Range.Interior.ColorIndex = p(pc).Color
        pc = pc + 1
    Wend
    
    Call kousin
    
    turn = 1
    While turn < MaxTurn
        For i = 0 To pc - 1
            If p(i).HP <> 0 Then
                p(i).TP = p(i).TP + p(i).SP
                If p(i).TP > 1000 Then
                    p(i).TP = p(i).TP - 1000
                    Call move(i)
                End If
            End If
        Next i
        DoEvents
    Wend
    
    MsgBox "終了"
End Sub

'行動決定
Sub move(i As Integer)
    Select Case turn Mod 7
        Case 0
            Select Case p(i).Muki
                Case "U"
                    p(i).Muki = "R"
                Case "R"
                    p(i).Muki = "D"
                Case "D"
                    p(i).Muki = "L"
                Case "L"
                    p(i).Muki = "U"
            End Select
        Case 1
            Select Case p(i).Muki
                Case "U"
                    p(i).Muki = "D"
                Case "R"
                    p(i).Muki = "L"
                Case "D"
                    p(i).Muki = "U"
                Case "L"
                    p(i).Muki = "R"
            End Select
        Case 2
             Select Case p(i).Muki
                Case "U"
                    p(i).Muki = "L"
                Case "R"
                    p(i).Muki = "U"
                Case "D"
                    p(i).Muki = "R"
                Case "L"
                    p(i).Muki = "D"
            End Select
        Case Else
            Call move2(i)
    End Select
    turn = turn + 1
    Cells(1, 12).Value = turn
    If turn Mod 97 = 0 Or turn Mod 13 = 0 Then
        turn = turn + 1
    End If
    
    Sleep (sleepTime)
End Sub

'前進
Sub move2(i As Integer)
    Select Case p(i).Muki
        Case "U"
            If p(i).Range.Row > 1 Then
                If p(i).Range.Offset(-1, 0).Value = "○" Then
                    Call atack(i, p(i).Range.Offset(-1, 0).Interior.ColorIndex - 3)
                Else
                    p(i).Range.Value = ""
                    Set p(i).Range = p(i).Range.Offset(-1, 0)
                End If
            End If
        Case "R"
            If p(i).Range.Column < 10 Then
                If p(i).Range.Offset(0, 1).Value = "○" Then
                    Call atack(i, p(i).Range.Offset(0, 1).Interior.ColorIndex - 3)
                Else
                    p(i).Range.Value = ""
                    Set p(i).Range = p(i).Range.Offset(0, 1)
                End If
            End If
        Case "D"
            If p(i).Range.Row < 10 Then
                If p(i).Range.Offset(1, 0).Value = "○" Then
                    Call atack(i, p(i).Range.Offset(1, 0).Interior.ColorIndex - 3)
                Else
                    p(i).Range.Value = ""
                    Set p(i).Range = p(i).Range.Offset(1, 0)
                End If
            End If
        Case "L"
            If p(i).Range.Column > 1 Then
                If p(i).Range.Offset(0, -1).Value = "○" Then
                    Call atack(i, p(i).Range.Offset(0, -1).Interior.ColorIndex - 3)
                Else
                    p(i).Range.Value = ""
                    Set p(i).Range = p(i).Range.Offset(0, -1)
                End If
            End If
    End Select
    p(i).Range.Value = "○"
    p(i).Range.Interior.ColorIndex = p(i).Color
    Call kousin
End Sub

'攻撃
Sub atack(i As Integer, j As Integer)
    p(j).HP = p(j).HP - p(i).AP
    If p(j).HP <= 0 Then
        MsgBox p(j).Name & "は" & p(i).Name & "に倒された"
        p(j).HP = 0
        p(j).Range.Value = ""
    End If
End Sub

'得点更新
Sub kousin()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim count As Integer
    
    For i = 1 To pc
        count = 0
        For j = 1 To 10
            For k = 1 To 10
                If Cells(j, k).Interior.ColorIndex = p(i - 1).Color Then
                    count = count + 1
                End If
            Next k
        Next j
        Cells(i + 1, 19).Value = count
        Cells(i + 1, 18).Value = p(i - 1).HP
    Next i
End Sub

参加者データ

名前	スタート	体力	攻撃力	速さ
totsuan	B8	31	40	29
type9	C8	30	5	65
noir_k	B7	50	20	30
s-n-k	C9	60	15	25
Zelda	I9	40	25	35
Mook	G6	1	0	99
taknt	J10	30	40	30
nakata-ryo	H4	60	10	30
kumaimizuki	A10	80	8	12
FLOW_GAMA	A1	25	50	25