色を指定したら、その色が使われているセルを返す関数

昨日、こんなものを作ってみた。
infoment.hatenablog.com

それでは恒例の、何とかの一つ覚え。これをクラスモジュールで実現してみる。

下ごしらえとして、以下を考えてみた。

1. 指定範囲の色情報を、二次元配列で持つ。
   特に指定が無い場合、シート内で使用する全範囲を対象とする。
2. クラスモジュールの初期化時に、1. を自動で取得しておく。
3. 対象となる範囲で、指定した色で塗り潰されたセルを探し、その範囲を戻り値とする関数を作成する。

こんな感じで。

クラスモジュール（ColorInfo）

Option Explicit

Private ColorInfoArray() As Variant
Public TargetRange As Range

Private Sub Class_Initialize()
    Call init
End Sub

Public Sub init(Optional target_range As Range)
    ' 行番号のループ変数。
    Dim r As Long
    ' 列番号のループ変数。
    Dim c As Long
    
        If target_range Is Nothing Then
            Set target_range = ActiveSheet.UsedRange
            Set TargetRange = target_range
        End If
    
    ' シート内の使用範囲全てを、今回の処理対象とする。
        With target_range
        
        ' 各セルの色情報を格納するための配列。
            ColorInfoArray = .Value
            For r = 1 To .Rows.Count
                For c = 1 To .Columns.Count
                    ColorInfoArray(r, c) = .Cells(r, c).Interior.Color
                Next
            Next
                
        End With
End Sub

Public Function GetColorRange(color_constant As Double) As Range
    ' 行番号のループ変数。
    Dim r As Long
    ' 列番号のループ変数。
    Dim c As Long
    ' 特定色のセル。
    Dim myRng As Range
    
        With TargetRange
            For r = 1 To .Rows.Count
                For c = 1 To .Columns.Count
                    If ColorInfoArray(r, c) = color_constant Then
                        If myRng Is Nothing Then
                            Set myRng = .Cells(r, c)
                        Else
                            Set myRng = Union(myRng, .Cells(r, c))
                        End If
                    End If
                Next
            Next
        End With
        
        Set GetColorRange = myRng
End Function

それでは、↓ の黄色を、全部青に変更してみよう。

Sub Sample()
    With New ColorInfo
        .GetColorRange(vbYellow).Interior.Color = vbBlue
    End With
End Sub

ここまで作って、ふと思った。色が複数ある場合は、どうしようか。

明日に続きます。

参考まで。