値によってセルを色分けする

数字を可視化する方法として
セルに値の大小によって異なった色を付けて
グラフ化したいと思います。

まず、色分けするシートを作成します。
下のコードは以前の記事『 虫食い 』で使ったものを
一部変更したものです。

一回通る度にセルの値に1を足していきます。
たくさん通ればほど値は大きくなります。

コードはこちら

Sub macro110813a()
'虫食い2

    Application.ScreenUpdating = False
    Sheets.Add
   
    Dim i As Long
    Dim MyRange As Range
    Dim r As Range
    Set r = Selection
   
    'セルの大きさ変更
    Cells.RowHeight = 3
    Cells.ColumnWidth = 2 * (6.88 / 45)
   
    For i = 0 To 200000
'        r.Select
        Select Case Int(Rnd * 4)
            Case 0
                If r.Row + 1 < Rows.Count Then
                    r.Offset(1, 0).Interior.ColorIndex = 56
                    r.Offset(1, 0) = r.Offset(1, 0) + 1
                    Set r = r.Offset(1, 0)
                End If
            Case 1
                If r.Column + 1 < Columns.Count Then
                    r.Offset(0, 1).Interior.ColorIndex = 56
                    r.Offset(0, 1) = r.Offset(0, 1) + 1
                    Set r = r.Offset(0, 1)
                End If
            Case 2
                If r.Row - 1 > 0 Then
                    r.Offset(-1, 0).Interior.ColorIndex = 56
                    r.Offset(-1, 0) = r.Offset(-1, 0) + 1
                    Set r = r.Offset(-1, 0)
                End If
            Case 3
                If r.Column - 1 > 0 Then
                    r.Offset(0, - 1).Interior.ColorIndex = 56
                    r.Offset(0, -1) = r.Offset(0, -1) + 1
                    Set r = r.Offset(0, -1)
                End If
        End Select
    Next i
   
    Application.ScreenUpdating = True
   
End Sub

上のプロシージャでできた1色のシートを使用して
セルの色づけをしていきます。

まずはカラーパレットを
赤単色のグラデーションにします。
このカラーパレットを変更するコードは
以前の記事で使ったものを少し変更したものです。

以前の記事では
手動で色を付けることを前提にしていたので、
見た目のカラーパレットの順序でグラデーションにしていましたが
今回はColorIndexの順番でグラデーションにしています。
そのために変数MyIndexを変更しています。

その他にも今回はカラーパレット56個すべて使うので
For文のところ最大値が55にそれに伴って
RGBを設定するところも変更してあります。

カラーパレットを確認するプロシージャも
以前の記事にありますので、
これらは上のGoogleで検索してみてください。

色を付ける段階についてですが、
Selectステートメントを使って
値によって分岐してセルに塗りつぶしの設定をしていきます。

コードはこちら

Sub macro110813b()
'値によって色分け
   
    'カラーパレットの変更
    '任意 の色0から任意の色1のグラデーション
   
        '任意の色の設定
        Dim r0, g0, b0, r1, g1, b1 As Integer
        r0 = 255: g0 = 255: b0 = 255
        r1 = 255: g1 = 0: b1 = 0
       
        Dim i, r, g, b As Integer
        Dim MyIndex As Variant
        MyIndex = Array(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)
   
        For i = 0 To 55
            r = r0 + Int((r1 - r0) * i / 55)
            g = g0 + Int((g1 - g0) * i / 55)
            b = b0 + Int((b1 - b0) * i / 55)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
'            Debug.Print r & "," & g & "," & b
        Next i

    '色 分け
    Dim rng As Range
    Dim MyRange As Range
    Set MyRange = ActiveSheet.UsedRange '全セル
   
    For Each rng In MyRange
        rng.Select
        Select Case rng.Value
            Case Is > 30
                rng.Interior.ColorIndex = 55
            Case 20 To 29
                rng.Interior.ColorIndex = 45
            Case 10 To 19
                rng.Interior.ColorIndex = 35
            Case 7 To 9
                rng.Interior.ColorIndex = 25
            Case 4 To 6
                rng.Interior.ColorIndex = 15
            Case 1 To 3
                rng.Interior.ColorIndex = 5
            Case Else
                rng.Interior.ColorIndex = 1
        End Select
    Next rng
   
End Sub

実行後のシートはこのようになります。

これで虫さんがどこをたくさん通ったか
バッチリわかります。