Excel VBA 選択したセルの色と同じ色のセルが含まれるデータを抽出する

スポンサーリンク
スポンサーリンク

データ範囲の選択したセルの色と同じ色のセルが含まれるデータを抽出する方法

データ範囲の値に目印のためセルに背景色を付けてデータを管理している場合があると思います。

同じ目印(セルの背景色)のデータだけをデータ範囲に抽出したい場合に方法として考えられるのは、Exceの「ホーム」タブにある「検索とフィルター」メニューの中の「フィルター」機能の「色フィルター」で抽出する方法が考えられますが、この方法では、列を基準に抽出するために、例えば1列目を基準にした場合は、2列目のデータに選択した色が含まれていた場合は、無視されて1列目に選択された色が含まれているデータだけが抽出されます。

また、VBAでは、Raneg【レンジ】オブジェクトのAutoFilter【オートフィルター】メソッドを使用し、フィルターの種類を表す引数Operator【オペレータ】に色フィルターを表す定数「xlFilterCellColor」を指定して抽出する方法がありますが、こちらも、抽出対象の列番号を指定する引数Field【フィールド】に列番号を指定しなくてはいけないので、上記と同じで列を基準とするデータの抽出になってしまします。

そこで、フィルター機能を使用しないで、指定した背景色のセルが含まれるデータをデータ範囲に抽出する方法について、ご紹介します。

データ範囲の抽出したいセルの背景色のセルと同じ背景色のセルを選択して、その背景色を変数に格納します。データ範囲の行をすべて一旦非表示にして、繰り返し処理でセルをすべて参照し、条件分岐を使用して変数に格納した、セルの背景色と同じ背景色のセルだった場合にそのセルが含まれる行を非表示から表示に切り替えます。これによりフィルター機能を使用せずに、結果的にデータ範囲の選択したセルの色と同じ色のセルが含まれるデータを抽出した状態になります。

実行結果

(選択したA2セルの背景色と同じセルの背景色が含まれるデータを抽出する例)


コード例

Sub 色抽出()
Dim 色 As Long
Dim 範囲 As Range
Dim セル As Range
On Error GoTo エラー処理
Set セル = Application.InputBox("抽出するセルの色と同じセルの色の単体セルを選択してください。", Type:=8)
色 = セル.Interior.Color
Range("A1").CurrentRegion.Select
Set 範囲 = Selection.Offset(1).Resize(Selection.Rows.Count - 1)
If 色 = 0 Then
MsgBox "セル範囲ではなく単体のセルを選択してください。"
Exit Sub
End If
範囲.EntireRow.Hidden = True
For Each セル In 範囲
If セル.Interior.Color = 色 Then
セル.EntireRow.Hidden = False
End If
Next
エラー処理:
End Sub

コードの解説

2行目【Dim 色 As Long】
セルの背景色を表すInterior【インテリア】オブジェクトのColor【カラー】プロパティで取得した選択したセルの背景色を格納する変数「色」を長整数型(Long)で宣言します。


3行目【Dim 範囲 As Range】
データ範囲の1行目の項目行を除いた範囲を格納する変数「範囲」をオブジェクト型(Range)で宣言します。


4行目【Dim セル As Range】
インプットボックスでユーザーから受け取った抽出する背景色のセルと繰り返し処理の中でデータ範囲からのセルの両方を格納する変数「セル」をオブジェクト型(Range)で宣言します。


5行目【On Error GoTo エラー処理】
6行目のApplication【アプリケーション】オブジェクトのInputBox【インプットボックス】メソッドでユーザーがキャンセルボタンや✕ボタンを押した場合にFalseが返り、エラーでデバックモードになってしまうので、On Error【オンエラー】ステートメントとGoTo【ゴゥトゥ】ステートメントを使用して、プロシージャーの終了前の「エラー処理ラベル」まで処理を飛ばします。

つまり、エラーになった場合は、何もしないで、プロシージャーを終了します。


6行目【Set セル = Application.InputBox(“抽出するセルの色と同じセルの色の単体セルを選択してください。”, Type:=8)】
Application【アプリケーション】オブジェクトのInputBox【インプットボックス】メソッドを使用し、受け取るデータの種類を設定する引数Type【タイプ】にセル範囲を表す8を設定してユーザーから、抽出するセルの色と同じセルの色のセルを選択してもらい、オブジェクト変数「セル」にSet【セット】キーワードを使用して代入します。


7行目【色 = セル.Interior.Color】
抽出するセルの色と同じセルの色のセルが格納されている変数「セル」にInterior【インテリア】プロパティで、そのセルの背景を表すInterior【インテリア】オブジェクトを参照し、Color【カラー】プロパティでその色を取得し、変数「色」に代入します。


8行目【Range(“A1”).CurrentRegion.Select】
Range【レンジ】オブジェクトのCurrentRegion【カレントリジョン】プロパティを使用してA1セルから始まるデータ範囲を参照して、Range【レンジ】オブジェクトのSelect【セレクト】メソッドで選択します。


9行目【Set 範囲 = Selection.Offset(1).Resize(Selection.Rows.Count – 1)】
選択されているデータ範囲をOffset【オフセット】プロパティで選択範囲を行方向で一段下げて、Resize【リサイズ】プロパティで、選択されている範囲の最後の行番号から1減算した行数に選択範囲を変更します。つまり、1行目の項目行を除いたデータ範囲を参照して、オブジェクト変数「範囲」にSet【セット】キーワードを使用して代入します。


10行目【If 色 = 0 Then】
If【イフ】ステートメント(条件分岐)を使用して、変数「色」の値が0と等しいときを定義します。選択したセルの色番号が格納されている変数「色」の値が0になる場合は、変数「セル」の値が単体のセルでななくセル範囲になっていてInterior【インテリア】オブジェクトのColor【カラー】プロパティで値が取得できなかった場合です。


11~12行目【MsgBox “セル範囲ではなく単体のセルを選択してください。”
Exit Sub】
上記の条件が成立した場合、つまり変数「色」に値が0の場合、MsgBox【メッセージボックス】関数を使用してユーザーにメッセージを表示して、Exit【エグジット】ステートメントでSub【サブ】プロシージャーを途中で終了します。


13行目【範囲.EntireRow.Hidden = True】
オブジェクト変数「範囲」のEntireRow【エンタイヤロウ】プロパティで参照したすべての行の表示、非表示を設定するHidden【ヒデン】プロパティにTrueを設定して、オブジェクト型変数「範囲」に格納されている範囲の行を非表示にします。つまり、項目行を除くデータ範囲をすべて非表示にします。


14行目【For Each セル In 範囲】
For Each【フォーイーチ】ステートメントを使用して繰り返し処理の始まりです。綱目行を除くデータ範囲が格納されているオブジェクト変数「範囲」から繰り返し処理の中で順に単体のセルを取り出しオブジェクト変数「セル」に代入して、変数「範囲」内のセルの数分繰り返し処理を実行します。


15行目【If セル.Interior.Color = 色 Then】
If【イフ】ステートメントを使用して、オブジェクト変数「セル」の背景色が変数「色」に格納されている色の値と等しいときを定義します。


16行目【セル.EntireRow.Hidden = False】
上記の条件分岐が成立したとき、オブジェクト変数「セル」に格納されているセルのEntireRow【エンタイヤロウ】プロパティでそのセルが含まれる行を参照し、Hidden【ヒデン】プロパティにFalseを設定して行を再表示します。つまり、最初に選択したセルの背景色を同じ色のセルが合った場合、そのセルが含まれる行を再表示します。


以上で、データ範囲の選択したセルの色と同じ色のセルが含まれるデータを抽出する方法についての解説を終了します。ありがとうございました。

スポンサーリンク
スポンサーリンク
スポンサーリンク
スポンサーリンク