Excel VBAを活用してスプラトゥーンの「ナワバトラー」を再現してみた。

最初に

　最近、友達と『スプラトゥーン３』のゲーム内で楽しめるカードゲーム「ナワバトラー」の対戦に夢中になり、より強いデッキを組みたくなりました。ゲーム内には「試し置き」という機能があり、これを用いてデッキの考察ができるのですが、自分の持っているカードしか試し置きに使えません。そこで、Excel VBAを活用してを使って「ナワバトラー」の試し置きを再現し、全てのカードを使って試し置きができるようにしました。
　

開発環境

Microsoft Excel 2019

完成図

　リストからステージを選択し、別のシートで作成したデッキを表示します。カードNo.を入力した後、右回転ボタンでカードを回転させ、ステージ上のアクティブセルにセットボタンを押すと、そのカードが貼り付けられます。

1.カード一覧を作る

　カードNo.、名前、マス数、7×7の正方形のセル、SPの列を作成します。
（7×7なのはナワバトラーのカードの大きさは最大で幅7マスのため）

　今回は条件付き書式設定で格子状のセルには1が入れられるとセルが黄色に塗りつぶされ、2が入れられるとセルが橙色に塗りつぶされるように設定します。数字をみえないようにするために、文字の色も背景色と同色にします。
枠ができたら、ゲームでカードを見るかもしくはカードが載っているサイトでカードを見ながら、カードNo.、名前、マス数、7×7の正方形のセル、SPの列を埋めます。（ここが一番時間かかりました）

2.ステージ一覧を作る

　セルが正方形になるように列と行の幅を調整した後、ステージの外枠を太線で囲い、先ほどと同様に条件付き書式設定で格子状のセルには1が入れられるとセルが黄色、2が入れられるとセルが橙色に塗りつぶされるように設定します。

3.デッキ登録シートの作成

デッキの枚数は15枚であるため次の画像のように並べます。ピンク色のセルにカード番号を入れると、名前、マス名、SP、形が出力されるようにします。

名前、マス名、SPはVLOOKUP関数を使ってカード一覧を参照します。（マス名、SPは割愛）

形の部分はピンクのセルに数字が変更されたときにマクロが実行されるようにする。

デッキ登録シートの内容が変更されたときに実行されるイベントハンドラを設定する。

イベントプロシージャを作成・編集するには、VBAエディタ内で対象となるワークシートの名前をダブルクリックして、シートモジュールを開きます。その後、上部のドロップダウンリストから "Worksheet" を選択し、右側のドロップダウンリストから "Change" を選択することで、Worksheet_Change イベントプロシージャを追加・編集することができます。

デッキ登録シートのピンク色のセルが変更されたときにsetCardRegi プロシージャを呼び出します。

デッキ登録シート

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Row >= 2 And Target.Row <= 30 Then
        Select Case Target.Column
            Case 4, 15, 26 ' これは列 D, O, Z を指す。
                Call setCardRegi
        End Select
    End If

End Sub

setCardRegi プロシージャでは、まず指定されたセル範囲の内容をクリアします。次に、setCardNum 関数を複数回呼び出して、カード番号を設定します。

Sub setCardRegi()

    ' セル範囲の内容をクリア
    Dim rangesToClear As Variant
    rangesToClear = Array("H2:N36", "S2:Y36", "AD2:AJ36")
    
    For Each rngStr In rangesToClear
        Range(rngStr).ClearContents
    Next rngStr
    
    ' setCardNumを複数回呼び出し
    Dim initialCols As Variant
    initialCols = Array(4, 4 + 11, 4 + 11 + 11)
    
    For Each col In initialCols
        For i = 0 To 4
            Call setCardNum(2 + 7 * i, col)
        Next i
    Next col

End Sub

setCardNum 関数では、指定されたセルの位置に基づいて、シート（"カード一覧"）から7x7のセルの値を取得し、その値を現在のワークシートの指定された位置に配置します。

Function setCardNum(ByVal NoC As Integer, ByVal NoR As Integer)

    ' 現在のワークシートの指定されたセルの値を確認
    ' セルの値が1以上の場合にのみ、以下の処理を実行
    If Cells(NoC, NoR).Value >= 1 Then

        ' sCはカード一覧シートでの開始列を示す
        Dim sC As Long
        sC = 1

        ' sRはカード一覧シートでの開始行を計算する
        ' 指定されたセルの値に基づいて、カード一覧から取得する行の開始位置を計算
        Dim sR As Long
        sR = 7 * (Cells(NoC, NoR).Value - 1) + 2

        ' 7x7のセルの値を格納するための配列を宣言
        Dim cardValues(1 To 7, 1 To 7) As Long

        ' カード一覧シートから7x7の値を取得して、cardValues配列に格納
        For i = 1 To 7
            For j = 1 To 7
                cardValues(i, j) = Worksheets("カード一覧").Cells(sR + i - 1, sC + 2 + j).Value
            Next j
        Next i

        ' 現在のワークシートの指定された位置から、取得した7x7の値を配置
        For i = 1 To 7
            For j = 1 To 7
                Cells(NoC + i - 1, NoR + 3 + j).Value = cardValues(i, j)
            Next j
        Next i

    End If

End Function

※コードを書く際には、レイアウトの変更などによって指定する行や列が異なる場合が考えられます。そのため、行や列の指定部分には注意してください。
最後に変更するセル（ピンクで塗りつぶしている部分）以外を書き換えないようにロックします。編集できるセルを選択し、ホーム→書式→セルのロックをしてから校閲タブでシートの保護をします。

3-1 デッキの登録、呼出、削除をできるようにする

デッキの登録をできるようにする

15枚のカードを入力し、登録デッキNoを選択し、ボタンを押すとデッキが登録されるようにする。

登録ボタンを押すとカードNoがデッキ名の横のセルに格納されるようにします。
デッキ名は好きな名前を入力し、登録の列は15枚登録されているか確認する関数を入れます。15枚登録されていると"〇15枚"登録されてないと"△15枚未満"と出力させます。
=IF(COUNTIF(AX12:BL12,">=1")=0,"",IF(COUNTIF(AX12:BL12,">=1")=15,"〇15枚","△15枚未満"))

見栄えが悪いためこの赤い部分の列は非表示にします。

登録ボタンの処理

Sub deckRegi()
      'デッキの登録
  'デッキ番号の取得
  Dim deckNo As Long
  deckNo = Range("AM20").Value

'setDeck関数を呼び出す
  Call setDeck(11 + deckNo, 50)
  MsgBox "デッキ" & deckNo & "に登録しました"

End Sub

setDeck関数

Function setDeck(ByVal sR As Integer, ByVal sC As Integer)
    '指定された行と列から開始して、3つの列 ("D", "O", "Z") からのデータを
    '取得して、目的の位置のセルにコピーする。

    Dim columns As Variant
    columns = Array("D", "O", "Z")
    
    Dim i As Integer, j As Integer
    Dim currentCol As String

    For i = 0 To 2
        currentCol = columns(i)
        For j = 0 To 4
            Cells(sR, sC + i * 5 + j).Value = Range(currentCol & (2 + j * 7)).Value
        Next j
    Next i

End Function

ボタンにマクロの登録をします。

3-2 デッキの呼出をできるようにする

呼出するデッキNoを選択し、呼出ボタンを押すと15枚のカードのNo、名前、SP、形が出力されるようにします。

呼出ボタンの処理

Sub deckOutput()
    '変数の宣言
    Dim n As Long
    Dim arr() As Long
    Dim i As Integer
    Dim startRows As Variant
    Dim columns As Variant
    
    'AM22からデッキ番号を取得
    n = Range("AM22").Value
    
    'デッキ番号からdeckArray関数を使いデッキの内容を取得
    arr = deckArray(n)
    
    '開始行と列の配列を定義
    startRows = Array(2, 9, 16, 23, 30)
    columns = Array("D", "O", "Z")
    
    'デッキの内容を適切なセルに出力
    For i = 1 To 15
        Range(columns((i - 1) \ 5) & startRows((i - 1) Mod 5)).Value = arr(i)
    Next i
End Sub

deckArray関数

Function deckArray(ByVal no As Integer) As Long()
    '15個のカード番号を配列で格納
    Dim x(15) As Long
    Dim ws As Worksheet
    Dim startCol As Long
    Dim i As Integer
    
    'ワークシートの参照を変数に格納
    Set ws = Worksheets("デッキ登録")
    
    '開始列番号
    startCol = 50
    
    'ループを使用して配列に値を格納
    For i = 1 To 15
        x(i) = ws.Cells(11 + no, startCol + i - 1).Value
    Next i
    
    '戻り値
    deckArray = x
End Function

ボタンにマクロの登録をします。

3-3 デッキの削除をできるようにする

削除するデッキNoを選択し、削除ボタンを押すとデッキが削除されます。

削除ボタンの処理

Sub deckClear()
      'デッキの削除
  'デッキ番号の取得
  Dim n As Long
  n = Range("AM24").Value
  
  Range(Cells(11 + n, 50), Cells(11 + n, 65)).ClearContents
  MsgBox "デッキ" & deckNo & "を削除しました"

End Sub

4.メインのシートでカードの操作を行う

ステージの選択

ステージをリストから選択し、変更ボタンを押すとステージの変更をする。

変更ボタンの処理

Sub stage()
    '変数の宣言
    Dim stageNum As Integer
    Dim startRow As Integer
    Dim wsStageList As Worksheet
    Dim wsTarget As Worksheet
    Dim rangeToCopy As Range
    Dim targetCell As Range

    'ワークシートの参照を設定
    Set wsStageList = Worksheets("ステージ一覧")
    Set wsTarget = Worksheets("シート")

    'シートのセル「H2」のステージ番号を取得
    stageNum = wsTarget.Range("G2").Value

    'ステージ番号に基づいて、コピー開始行を計算
    startRow = (stageNum - 1) * 30 + 3

    '範囲を設定してコピー
    Set rangeToCopy = wsStageList.Range(wsStageList.Cells(startRow, 1), wsStageList.Cells(startRow + 27, 21))
    rangeToCopy.Copy

    'ターゲットセルを設定してペースト
    Set targetCell = wsTarget.Range("B3")
    targetCell.PasteSpecial xlPasteAll

    'A列のみを再度コピーしてペースト
    wsStageList.Cells(startRow, 1).Copy
    targetCell.PasteSpecial xlPasteAll
End Sub

デッキの呼出

デッキをリストから選択したときにそのNoのデッキをシートから呼び出す。


シートのデッキNoが変更されたときに実行されるイベントハンドラを設定する。

Private Sub Worksheet_Change(ByVal Target As Range)
   
    If (Target.Row = 15) And (Target.Column = 27) Then
    Call deckOutputSheet1
    Call selectCardIndiSheet1
    End If 

End Sub

deckOutputSheet1()でカードNo、デッキ名、マス数を読み込んで出力します。
selectCardIndiSheet1()でカードの形を出力します。

Sub deckOutputSheet1()
    'シートのデッキ番号を選択すると15枚のデッキのカードを出力する
    Dim n As Long
    Dim arr() As Long
    Dim i As Integer
    Dim startRow As Long
    Dim colName As String
    
    n = Range("AA15").Value
    'deckArray関数を使ってデッキの内容を取得
    arr = deckArray(n)
    
    startRow = 16
    colName = "AA"
    
    For i = 1 To 15
        Range(colName & (startRow + i - 1)).Value = arr(i)
    Next i

End Sub

Sub selectCardIndiSheet1()
    '変数と定数の宣言
    Const START_ROW As Integer = 2
    Const ROW_INCREMENT As Integer = 8
    Const START_COLUMN As Integer = 40
    Const COLUMN_INCREMENT As Integer = 7
    Dim rowOffset As Integer
    Dim colOffset As Integer
    Dim i As Integer, j As Integer

    '4x4のセルのブロックを処理
    For i = 0 To 3
        For j = 0 To 3
            '現在の行と列のオフセットを計算
            rowOffset = START_ROW + i * ROW_INCREMENT
            colOffset = START_COLUMN + j * COLUMN_INCREMENT
            
            'selectCardSheet関数を呼び出し
            Call selectCardSheet(rowOffset, colOffset)
        Next j
    Next i
End Sub

Function selectCardSheet(ByVal sR As Integer, ByVal sC As Integer)
    '変数と定数の宣言
    Const CARD_COLUMNS_OFFSET As Integer = 3
    Const CARD_ROWS As Integer = 7
    Dim sC1 As Long, sR1 As Long
    Dim i As Integer, j As Integer
    Dim cardValue As Variant

    '指定されたセルからカードの基準となる行と列を取得
    sC1 = 1
    sR1 = 7 * (Cells(sR - 1, sC + 1).Value - 1) + 2

    '7x7のカードのブロックを処理
    For i = 0 To 6
        For j = 0 To 6
            'エラー処理の開始
            On Error Resume Next
            'カード一覧からカードの値を取得
            cardValue = Worksheets("カード一覧").Cells(sR1 + i, sC1 + CARD_COLUMNS_OFFSET + j).Value
            'エラー処理の終了
            On Error GoTo 0
            
            'カードの値が数字でない場合、デフォルトの値0を設定
            If Not IsNumeric(cardValue) Or IsEmpty(cardValue) Then cardValue = 0
            
            '指定されたセルにカードの値を書き込む
            Cells(sR + i, sC + j + 1).Value = cardValue
        Next j
    Next i
End Function

セットするカードの表示

　カード番号の入力することでそのカードを表示させる。

最初はデッキの15枚をリストなどにして選択するようにしていたのですが、デッキに入っていないカードとの組み合わせも試したくなったためカードNoを自分で入力するようにしました。

シートのカードNoが変更されたときに実行されるイベントハンドラを追加する。

Private Sub Worksheet_Change(ByVal Target As Range)
    '追加部分
    If (Target.Row = 12) And (Target.Column = 27) Then
    Call selectCard
    End If
    
    If (Target.Row = 15) And (Target.Column = 27) Then
    Call deckOutputSheet1
    Call selectCardIndiSheet1
    End If
    
End Sub

Sub selectCard()
    '変数の宣言
    Dim wsSheet As Worksheet
    Dim wsCardList As Worksheet
    Dim startRowCardList As Long
    Dim i As Integer, j As Integer
    Dim currentCellValue As Long
    Dim targetCell As Range
    
    'ワークシートの参照を設定
    Set wsSheet = Worksheets("シート")
    Set wsCardList = Worksheets("カード一覧")
    
    'シートのセル「AA12」の値を基に、カードの一覧から取得する開始行を計算
    startRowCardList = 7 * (wsSheet.Range("AA12").Value - 1) + 2
    
    '7x7のセルの値を取得し、目的のセルに配置
    For i = 0 To 6
        For j = 0 To 6
            'カードの一覧から値を取得
            currentCellValue = wsCardList.Cells(startRowCardList + i, 4![Something went wrong]()
 + j).Value
            
            '目的のセルに値を配置
            Set targetCell = wsSheet.Cells(3 + i, 27 + j)
            targetCell.Value = currentCellValue
        Next j
    Next i
End Sub

カードの回転

右回転ボタンを押すと赤い点線のセルを中心に右回転させる

右回転ボタンの処理

Sub rotate()
    Dim i As Integer, j As Integer
    Dim originalValues(1 To 7, 1 To 7) As Variant
    Dim rotatedValues(1 To 7, 1 To 7) As Variant
    Dim startRow As Integer, startCol As Integer
    
    '初期位置を設定
    startRow = 3
    startCol = ColumnNumber("AA")
    
    '元の7×7のセルの値の取得
    For i = 1 To 7
        For j = 1 To 7
            originalValues(i, j) = Cells(startRow + i - 1, startCol + j - 1).Value
        Next j
    Next i
    
    '値を右回転
    For i = 1 To 7
        For j = 1 To 7
            rotatedValues(j, 8 - i) = originalValues(i, j)
        Next j
    Next i
    
    '値をクリア
    Worksheets("シート").Range("AA3:AG9").ClearContents
    
    'セルに回転後の数値を入れる
    For i = 1 To 7
        For j = 1 To 7
            Cells(startRow + i - 1, startCol + j - 1).Value = rotatedValues(i, j)
        Next j
    Next i
End Sub

'列の文字を列の番号に変換する関数
Function ColumnNumber(ByVal colName As String) As Integer
    Dim i As Integer, length As Integer, num As Integer
    length = Len(colName)
    num = 0
    
    For i = 1 To length
        num = num * 26
        num = num + (Asc(UCase(Mid(colName, i, 1))) - Asc("A") + 1)
    Next i
    
    ColumnNumber = num
End Function

カードのセット

セットしたい場所のセルをアクティブにし、セットボタンを押すとカードがセットされる。

セットボタンの処理

Sub setCell()
    Dim i As Integer, j As Integer
    Dim sR As Long, sC As Long
    Dim values(1 To 7, 1 To 7) As Long
    Dim startRow As Integer, startCol As Integer
    
    'アクティブセルの行と列の取得
    sR = ActiveCell.Row
    sC = ActiveCell.Column
    
    '初期位置を設定
    startRow = 3
    startCol = ColumnNumber("AA")
    
    '7×7のセルの値の取得
    For i = 1 To 7
        For j = 1 To 7
            values(i, j) = Cells(startRow + i - 1, startCol + j - 1).Value
        Next j
    Next i
    
    'アクティブセルを中心とした7x7のセルに値を追加する
    For i = 1 To 7
        For j = 1 To 7
            Cells(sR - 4 + i, sC - 4 + j).Value = Cells(sR - 4 + i, sC - 4 + j).Value + values(i, j)
        Next j
    Next i
End Sub

'列の文字を列の番号に変換する関数
Function ColumnNumber(ByVal colName As String) As Integer
    Dim k As Integer, length As Integer, num As Integer
    length = Len(colName)
    num = 0
    
    For k = 1 To length
        num = num * 26
        num = num + (Asc(UCase(Mid(colName, k, 1))) - Asc("A") + 1)
    Next k
    
    ColumnNumber = num
End Function

完成

試し置きができるようになりました。

最後に

　「ナワバトラー」の試し置きをExcelで再現することができました。これにより、持っていないカードも試し置きできるようになり、強いデッキ作成の際の参考として活用できます。しかし、まだ改善の余地があるため、時間がある際には、さらなる機能の追加やコードの最適化を行っていきたいと思います。