Excel VBA でマップエディタっぽいものを作ってみた

参考：
戦略SLGをつくる：Hex（ヘックス）マップの座標系構造

上記ページにてExcelシートでシュミレーションゲームのマップエディタを作る構想が公開されていました。それを主に条件付き書式で実装してみました。結果的には大判の背景を使うと重くなってしまうExcel側の問題で採用は見送りましたが、オリジナルマップを作るにはいいかもしれません。

環境：
Excel2016(RC参照有効) windows10

##コード

VBA

Sub cells_shaping()

Dim c As Integer
Dim r As Integer

For c = 1 To 140
    Columns(c).ColumnWidth = 7
Next c
    
For r = 1 To 340
    Rows(r).RowHeight = 20
Next r

End Sub

Sub cells_numbering()

For c = 1 To 140
    For r = 1 To 340
        If c Mod 2 = 1 And r Mod 2 = 1 Then
            cs = Format(c)
            rs = Format(r)
            Cells(r, c).Value = cs + "," + rs
        ElseIf c Mod 2 = 0 And r Mod 2 = 0 Then
            cs = Format(c)
            rs = Format(r)
            Cells(r, c).Value = cs + "," + rs
        ElseIf c Mod 2 = 1 And r Mod 2 = 0 Then
            Cells(r, c).Value = ","
        ElseIf c Mod 2 = 0 And r Mod 2 = 1 And r > 1 Then
            Cells(r, c).Value = ","
        End If
    Next r
Next c

End Sub

Sub cells_color_format()

Dim MyRange As Range

Set MyRange = Range(Cells(1, 1), Cells(340, 130))

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(1,R[1]C)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=1),AND(SEARCH(1,R[1]C)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=0))"
MyRange.FormatConditions(1).Interior.Color = RGB(65, 105, 225) 'ocean 海洋 = 1 royalblue

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(1,RC)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=0),AND(SEARCH(1,RC)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=1))"
MyRange.FormatConditions(2).Interior.Color = RGB(65, 105, 225) 'ocean 海洋 = 1 royalblue

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(2,R[1]C)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=1),AND(SEARCH(2,R[1]C)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=0))"
MyRange.FormatConditions(3).Interior.Color = RGB(222, 184, 135) 'ground 平地 = 2 burlywood

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(2,RC)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=0),AND(SEARCH(2,RC)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=1))"
MyRange.FormatConditions(4).Interior.Color = RGB(222, 184, 135) 'ground 平地 = 2 burlywood

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(3,R[1]C)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=1),AND(SEARCH(3,R[1]C)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=0))"
MyRange.FormatConditions(5).Interior.Color = RGB(34, 139, 34) 'forest 森林 = 3 forestgreen

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(3,RC)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=0),AND(SEARCH(3,RC)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=1))"
MyRange.FormatConditions(6).Interior.Color = RGB(34, 139, 34) 'forest 森林 = 3 forestgreen

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(4,R[1]C)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=1),AND(SEARCH(4,R[1]C)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=0))"
MyRange.FormatConditions(7).Interior.Color = RGB(139, 69, 19) 'mountain 山岳 = 4 saddlebrown

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(4,RC)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=0),AND(SEARCH(4,RC)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=1))"
MyRange.FormatConditions(8).Interior.Color = RGB(139, 69, 19) 'mountain 山岳 = 4 saddlebrown

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(5,R[1]C)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=1),AND(SEARCH(5,R[1]C)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=0))"
MyRange.FormatConditions(9).Interior.Color = RGB(240, 230, 140) 'desert 砂漠 = 5 khaki

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(5,RC)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=0),AND(SEARCH(5,RC)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=1))"
MyRange.FormatConditions(10).Interior.Color = RGB(240, 230, 140) 'desert 砂漠 = 5 khaki

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(6,R[1]C)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=1),AND(SEARCH(6,R[1]C)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=0))"
MyRange.FormatConditions(11).Interior.Color = RGB(60, 179, 113) 'wetland 湿地 = 6 mediumseagreen

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(6,RC)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=0),AND(SEARCH(6,RC)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=1))"
MyRange.FormatConditions(12).Interior.Color = RGB(60, 179, 113) 'wetland 湿地 = 6 mediumseagreen

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(7,R[1]C)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=1),AND(SEARCH(7,R[1]C)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=0))"
MyRange.FormatConditions(13).Interior.Color = RGB(211, 211, 211) 'city 都市 = 7 lightgrey

MyRange.FormatConditions.Add Type:=xlExpression, _
Formula1:="=OR(AND(SEARCH(7,RC)=1,MOD(ROW(),2)=1,MOD(COLUMN(),2)=0),AND(SEARCH(7,RC)=1,MOD(ROW(),2)=0,MOD(COLUMN(),2)=1))"
MyRange.FormatConditions(14).Interior.Color = RGB(211, 211, 211) 'city 都市 = 7 lightgrey

End Sub

##解説

• ３つの関数から成っています。一つ目はセルを正方形に調整する関数。二つ目はナンバリング。３つめは条件付き書式の入力です。
• 土地のタイプは７種類用意しています。
• はじめにセルの表示方法を A1 B1 C1 のような表示形式ではなく、R1C1参照に変更します。ファイル→オプション→数式→R1C1参照形式を使用する　を選択します。これでRC（R0C0の意）と表記することでアクティブセルを参照することができます。
• グリットの下部のセルの一番右側の数字でセルの色を決定します。

実行後の画面