セルの色分けコードを自動生成するマクロ

カテゴリや種別が設定されたデータにおいて、
種別ごとに色分けを行いたいことが良くあります。

この設定を条件付き書式ではなくマクロで行う場合は、
以下のようなコードを書くことになります。

' 値ごとに着色
Select Case 着色セル.Value
    Case "ノーマル": 着色セル.Interior.Color = RGB(153, 153, 153)
    Case "くさ": 着色セル.Interior.Color = RGB(66, 191, 37)
    Case "ほのお": 着色セル.Interior.Color = RGB(253, 99, 42)
    Case "みず": 着色セル.Interior.Color = RGB(42, 145, 254)
    Case "でんき": 着色セル.Interior.Color = RGB(253, 220, 0)
    Case "むし": 着色セル.Interior.Color = RGB(159, 166, 38)
    Case "ひこう": 着色セル.Interior.Color = RGB(153, 202, 254)
    Case "いわ": 着色セル.Interior.Color = RGB(188, 184, 140)
    Case "どく": 着色セル.Interior.Color = RGB(153, 78, 206)
    Case "じめん": 着色セル.Interior.Color = RGB(170, 124, 58)
    Case "こおり": 着色セル.Interior.Color = RGB(69, 215, 254)
    Case "かくとう": 着色セル.Interior.Color = RGB(254, 162, 2)
    Case "エスパー": 着色セル.Interior.Color = RGB(255, 99, 132)
    Case "ゴースト": 着色セル.Interior.Color = RGB(112, 68, 114)
    Case "ドラゴン": 着色セル.Interior.Color = RGB(85, 98, 212)
    Case "あく": 着色セル.Interior.Color = RGB(80, 69, 73)
    Case "はがね": 着色セル.Interior.Color = RGB(107, 175, 209)
    Case "フェアリー": 着色セル.Interior.Color = RGB(253, 177, 255)
    Case "": 着色セル.Interior.ColorIndex = 0
End Select

このコードの詳しい解説はこちら
www.limecode.jp

さてこのコード、割と書くのが面倒なコードですので、
せっかくなのでマクロにマクロを書いてもらいましょう。

選択した範囲から値と背景色の組を取得して、
上記のコードをイミディエイトウィンドウに出力するマクロを紹介します。

ソースコード

' セルの色分けSelectCase文の生成
Sub 選択範囲のセル値と背景色の組からSelectCase文を生成する()

    ' 値(key)と色(item)の組を記憶するDictionary
    Dim Dic値ごとの色 As Object
    Set Dic値ごとの色 = CreateObject("Scripting.Dictionary")
    
    ' 選択範囲内のすべてのセルをループ
    Dim max文字数 As Long: max文字数 = 0
    Dim 現在の文字数 As Long
    Dim 選択範囲 As Range: Set 選択範囲 = Selection
    Dim セル As Range
    For Each セル In 選択範囲.Cells
        
        ' 新出のセル値でセル値と表示色の組を記録
        If Dic値ごとの色.Exists(セル.Value) = False And セル.Value <> "" Then
            Dic値ごとの色.Add セル.Value, セル.DisplayFormat.Interior.Color
        End If
    
        ' インデント調整用に最大文字数を取得
        現在の文字数 = LenB(StrConv(セル.Value, vbFromUnicode)) ' 半角を1、全角を2とカウント
        If 現在の文字数 > max文字数 Then: max文字数 = 現在の文字数
    
    Next
    
    Debug.Print "Select Case 着色セル.Value"
    
    ' すべてのセル値と表示色の組をコード化してイミディエイトへ出力
    Dim keyセル値
    For Each keyセル値 In Dic値ごとの色.Keys
    
        Dim スペースの数 As String
        スペースの数 = max文字数 - LenB(StrConv(keyセル値, vbFromUnicode))
    
        Debug.Print "    Case """ & keyセル値 & """: " & Space(スペースの数) _
            & "着色セル.Interior.Color = RGB(" & RGB値を各色のカンマ区切りに分解(Dic値ごとの色(keyセル値)); ")"

    Next
    
    Debug.Print "    Case """": 着色セル.Interior.ColorIndex = 0"
    Debug.Print "End Select"

End Sub

' RGB値 ⇒ R,G,B
Function RGB値を各色のカンマ区切りに分解(RGB値 As Long) As String
    Dim R, G, B
    R = RGB値 Mod 256
    G = Int(RGB値 / 256) Mod 256
    B = Int(RGB値 / 256 / 256)
    
    RGB値を各色のカンマ区切りに分解 = R & "," & G & "," & B
End Function

解説

セルの値と背景色の組をDictionaryに記憶していき、
あとはそれを愚直にDebug.Printしていくコードです。

「コードを文字列として生成してDebug.Print を連打する」
という手法は簡単で強力ですので是非覚えておきましょう。

背景色の設定値はInterior.Colorで取得できる値をそのまま使って、

Case "ノーマル": 着色セル.Interior.Color = 10066329

こんな風に書いても動きます。

この10066329はRGB値と呼ばれ「R + G×256 + B×256×256」で算出されており、
↓のコードで取得してみると、この値が入っているのがわかります。

• Debug.Print RGB(153, 153, 153)
• Debug.Print Selection.Interior.Color

これをそのまま代入してもいいのですが、
パッと見何色かわからないし、他に流用もできませんからね。

せっかくの汎用マクロなので、R,G,B形式への変換も同時に行っています。

同じくせっかくだからと実装した処理として、
文字数をカウントしてインデントをそろえるスペースを入れてみました。

今回出力したコードを「等幅フォント」のVBEに貼ると、
↓のように表示されます。

マルチステート「:」を使ったコードは「:」後にスペースを挿入できることを利用し、
第2コードのインデントもそろえることができます。

等幅フォントにしないとできないことなのですが、
設定するとかなりコードが見やすくなります。
（ブラウザは等幅フォントに出来ないため本記事では設定していませんが）

気に入ったら等幅フォントとセットで採用してみてください。