虫食い2

記事『虫食い』、
『値によってセルを色分けする』で使用したプロシ ージャを
再び変更して使用してます。

今回はカラーパレットをインデックス順に
カラースケール（レインボー）に
変更したものを使います。

カラースケールにパレットを変更するコードはこちら

Sub macro110911a()
'カラーパレットを変更
'色相のグラデーション
'ColorIndex順

    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 9
            r = 255
            g = Int(255 * i / 9)
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 10 To 19
            r = Int(255 - (255 * (i - 9) / 10))
            g = 255
            b = 0
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 20 To 28
            r = 0
            g = 255
            b = Int(255 * (i - 19) / 9)
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 29 To 37
            r = 0
            g = Int(255 - (255 * (i - 28) / 9))
            b = 255
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 38 To 46
            r = Int(255 * (i - 37) / 9)
            g = 0
            b = 255
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i
        For i = 47 To 55
            r = 255
            g = 0
            b = Int(255 - (255 * (i - 46) / 9))
            ActiveWorkbook.Colors(MyIndex(i)) = RGB(r, g, b)
            Debug.Print r & "," & g & "," & b
        Next i

End Sub

今回の規則は、
「セルを一回通るごとにColorIndexを+1する」
というものです。

ColorIndexは56までですので、
Switch関数で56以上にならないように
してあります。

コードはこちら

Sub macro110911b()
'虫食い2

    Application.ScreenUpdating = False
    Sheets.Add
   
    Dim i As Long
    Dim cIndex As Integer
    Dim MyRange As Range
    Dim r As Range
    Set r = Selection
   
    ' セルの大きさ変更
    Cells.RowHeight = 3
    Cells.ColumnWidth = 2 * (6.88 / 45)
    Cells.Interior.ColorIndex = 1
   
    For i = 0 To 1000000
'        r.Select
        Select Case Int(Rnd * 4)
            Case 0
                If r.Row + 1 < Rows.Count Then
                    cIndex = r.Offset(1, 0).Interior.ColorIndex
                    r.Offset(1, 0).Interior.ColorIndex = _
                        Switch(cIndex = 56, 56, True, cIndex + 1)
                    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
                    cIndex = r.Offset(1, 0).Interior.ColorIndex
                    r.Offset(0, 1).Interior.ColorIndex = _
                        Switch (cIndex = 56, 56, True, cIndex + 1)
                    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
                    cIndex = r.Offset(1, 0).Interior.ColorIndex
                    r.Offset(-1, 0).Interior.ColorIndex = _
                        Switch(cIndex = 56, 56, True, cIndex + 1)
                    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
                    cIndex = r.Offset(1, 0).Interior.ColorIndex
                    r.Offset(0, - 1).Interior.ColorIndex = _
                        Switch (cIndex = 56, 56, True, cIndex + 1)
                    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

実行後のシートの例：

ジャクソンポロック系？炎？

デフォルトのカラーパレットでは
なにかポップな印象でした。

いろいろなカラーパレットで試してみましたが
面白いです。