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

Sub 色でデータ抽出()
Dim データ範囲 As Range
Dim 抽出セル As Range
Dim 抽出セル1 As Range
Dim 色セル As Range
Dim 色 As Long
 Set データ範囲 = Range("A1").CurrentRegion
　On Error GoTo エラー処理
 Set 色セル = Application.InputBox("抽出するセルの色と同じセルの色の単体セルを選択してください。", Type:=8)
     色 = 色セル.Interior.Color
 If 色 = 0 Then
     MsgBox "セル範囲ではなく単体のセルを選択してください。"
 Exit Sub
 End If
    Application.FindFormat.Clear
    Application.FindFormat.Interior.Color = 色
 Set 抽出セル = データ範囲.Find("", searchformat:=True)
 Set 抽出セル1 = 抽出セル
 Do
    ActiveCell.Value = 抽出セル.Value
    ActiveCell.Offset(1, 0).Select
 Set 抽出セル = データ範囲.Find("", after:=抽出セル, searchformat:=True)
 Loop While 抽出セル1.Address <> 抽出セル.Address
    Application.FindFormat.Clear
　　エラー処理:
End Sub

3行目【Dim 抽出セル As Range】
Find【ﾌｧｲﾝﾄﾞ】メソッドで検索した結果のセルを格納する変数「抽出セル」をオブジェクト型(Range)で宣言します。

4行目【Dim 抽出セル1 As Range】
最初のFind【ﾌｧｲﾝﾄﾞ】メソッドでの検索結果のセルを格納する変数「抽出セル1」をオブジェクト型(Range)で宣言します。

5行目【Dim 色セル As Range】
Application【ｱﾌﾟﾘｹｰｼｮﾝ】オブジェクトのInputBox【ｲﾝﾌﾟｯﾄﾎﾞｯｸｽ】メソッドでユーザーから受け取った、検索する色のセル番地を格納する変数「色セル」をオブジェクト型(Range)で宣言します。

6行目【Dim 色 As Long】
ユーザーが選択した「検索する色のセル」が格納されている変数「色セル」にColor【ｶﾗｰ】プロパティを使用してそのセルの色番号を取得し、格納する変数「色」を長整数型(Long)で宣言します。

7行目【Set データ範囲 = Range(“A1”).CurrentRegion】
Range【ﾚﾝｼﾞ】オブジェクトのCurrentRegion【ｶﾚﾝﾄﾘｰｼﾞｮﾝ】プロパティを使用してA1セルから始まるデータ範囲を参照し、Set【ｾｯﾄ】キーワードを使用してオブジェクト変数「データ範囲」に代入します。

8行目【On Error GoTo エラー処理】
9行目のApplication【ｱﾌﾟﾘｹｰｼｮﾝ】オブジェクトのInputBox【ｲﾝﾌﾟｯﾄﾎﾞｯｸｽ】メソッドでユーザーがキャンセルボタンや✕ボタンを押した場合にFalseが返り、エラーでデバックモードになってしまうので、On Error【ｵﾝｴﾗｰ】ステートメントとGoTo【ｺﾞｩﾄｩ】ステートメントを使用して、プロシージャーの終了前の「エラー処理ラベル」まで処理を飛ばします。

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

9行目【Set 色セル = Application.InputBox(“抽出するセルの色と同じセルの色の単体セルを選択してください。”, Type:=8)】
Application【ｱﾌﾟﾘｹｰｼｮﾝ】オブジェクトのInputBox【ｲﾝﾌﾟｯﾄﾎﾞｯｸｽ】メソッドを使用し、受け取るデータの種類を設定する引数Type【ﾀｲﾌﾟ】にセル範囲を表す「8」を指定して、ユーザーから検索するセルの色と同じセルを受け取り、オブジェクト変数「色セル」にSet【ｾｯﾄ】キーワードを使用して代入します。

10行目【 色 = 色セル.Interior.Color】
検索する色のセルが格納されている変数「色セル」のInterior【ｲﾝﾃﾘｱ】プロパティを使用して、塗りつぶし属性を表すInterior【ｲﾝﾃﾘｱ】オブジェクトを取得し、色の取得や設定をするColor【ｶﾗｰ】プロパティを使用して、変数「色セル」の背景色を取得し、変数「色」に格納します。

11行目【If 色 = 0 Then】
Color【ｶﾗｰ】プロパティで取得するセルの背景色の範囲が単体のセルではなくセル範囲だった場合にColor【ｶﾗｰ】プロパティは「0」を返すので、If【ｲﾌ】ステートメントを使用して、Color【ｶﾗｰ】プロパティの戻り値が格納されている変数「色」の値が「0」だったときを定義します。つまり、ユーザーがInputBox【ｲﾝﾌﾟｯﾄﾎﾞｯｸｽ】メソッドで「単体セルではなくセル範囲を選択した場合」を定義します。

12～13行目【MsgBox “セル範囲ではなく単体のセルを選択してください。
Exit Sub“】
上記の条件分岐の条件式が成立した場合、MsgBox【ﾒｯｾｰｼﾞﾎﾞｯｸｽ】関数を使用してユーザーにメッセージを出し、Exit【ｴｸﾞｼﾞｯﾄ】ステートメントを使用してSub【ｻﾌﾞ】プロシージャーを途中で終了します。

15行目【Application.FindFormat.Clear】
Application【ｱﾌﾟﾘｹｰｼｮﾝ】オブジェクトのFindFormat【ﾌｧｲﾝﾄﾞﾌｫｰﾏｯﾄ】プロパティを使用して、検索する書式を表すCellFormat【ｾﾙﾌｫｰﾏｯﾄ】オブジェクトを取得し、Clear【ｸﾘｱ】メソッドで検索する書式を削除します。検索する書式が設定されているされていないに関わらず、書式検索をする場合は必ず実行します。

16行目【Application.FindFormat.Interior.Color = 色】
Application【ｱﾌﾟﾘｹｰｼｮﾝ】オブジェクトのFindFormat【ﾌｧｲﾝﾄﾞﾌｫｰﾏｯﾄ】プロパティを使用して、検索する書式を表すCellFormat【ｾﾙﾌｫｰﾏｯﾄ】オブジェクトを取得し、Interior【ｲﾝﾃﾘｱ】プロパティを使用して、塗りつぶし属性を表すInterior【ｲﾝﾃﾘｱ】オブジェクトを取得して、Color【ｶﾗｰ】プロパティに変数「色」に格納されている「検索する色番号」
を指定します。

17行目【Set 抽出セル = データ範囲.Find(“”, searchformat:=True)】
データの範囲が格納されている変数「データ範囲」に検索をするFind【ﾌｧｲﾝﾄﾞ】メソッドを使用して検索する値を設定する引数What【ﾜｯﾄ】には、値は検索しないので、「長さ0文字の文字列「””」」を指定し、検索するセルの書式を指定するかしないかを設定する引数searchformat【ｻｰﾁﾌｫｰﾏｯﾄ】にTrueを指定して「書式を指定する」に設定して15行目の検索する書式を表すCellFormat【ｾﾙﾌｫｰﾏｯﾄ】オブジェクトに設定した背景色を検索対象に設定し、検索した結果をSet【ｾｯﾄ】キーワードを使用してオブジェクト変数「抽出セル」に代入します。

18行目【Set 抽出セル1 = 抽出セル】
16行目のFind【ﾌｧｲﾝﾄﾞ】メソッドで検索された色のセルが格納されているオブジェクト変数「抽出セル」をSet【ｾｯﾄ】キーワードを使用してオブジェクト変数「抽出セル1」に代入します。

19行目【 Do】
Do Loop While【ﾄﾞｩﾙｰﾌﾟﾜｲﾙ】ステートメントで繰り返し処理の始まりです。

20行目【 ActiveCell.Value = 抽出セル.Value】
実行前に選択したアクティブセルに16行目で実行したFind【ﾌｧｲﾝﾄﾞ】メソッドで検索されたセルの値をRange【ﾚﾝｼﾞ】オブジェクトのValue【ﾊﾞﾘｭｰ】メソッドで取得して代入します。

21行目【 ActiveCell.Offset(1, 0).Select】
Range【ﾚﾝｼﾞ】オブジェクトのOffset【ｵﾌｾｯﾄ】プロパティを使用して、アクティブセルから1行下のセルを選択して、そのセルをアクティブにします。

22行目【Set 抽出セル = データ範囲.Find(“”, after:=抽出セル, searchformat:=True)】
データ範囲が格納されている変数「データ範囲」に検索するFind【ﾌｧｲﾝﾄﾞ】メソッドを実行します。検索の開始位置を指定する引数after【ｱﾌﾀｰ】には、16行目で実行した最初のFind【ﾌｧｲﾝﾄﾞ】メソッドで検索されたセルが格納されている変数「抽出セル」を設定し、すでに検索されたセルの次のセルから検索する設定にし、検索した結果をSet【ｾｯﾄ】キーワードを使用して、オブジェクト変数「抽出セル」に代入します。

23行目【Loop While 抽出セル1.Address <> 抽出セル.Address】
18行目の「Do」からここまでの処理を設定した条件を満たす間繰り返します。設定条件はオブジェクト変数「抽出セル1」のセルとオブジェクト変数「抽出セル」のセル番地をRange【ﾚﾝｼﾞ】オブジェクトのAddress【ｱﾄﾞﾚｽ】プロパティで取得して、セル番地が等しくない「＜＞」場合を設定条件に設定します。

つまり、変数「抽出セル1」には18行目で最初のFind【ﾌｧｲﾝﾄﾞ】メソッドで検索された「セル」が格納されていて、変数「抽出セル」には、19行目以降の繰り返し処理内のFind【ﾌｧｲﾝﾄﾞ】メソッドで検索された「セル」が次々に代入されます。変数「抽出セル1」と変数「抽出」のセル番地が一致したとき、すべてセルの検索が終了したことを表すので、繰り返し処理から抜け出します。

24行目【 Application.FindFormat.Clear】
Application【ｱﾌﾟﾘｹｰｼｮﾝ】オブジェクトのFindFormat【ﾌｧｲﾝﾄﾞﾌｫｰﾏｯﾄ】プロパティで取得した検索する書式を表すCellFormat【ｾﾙﾌｫｰﾏｯﾄ】オブジェクトをClear【ｸﾘｱ】メソッドで削除します。書式検索は、検索設定が残ってしまうので、書式検索した場合は検索書式を必ず、削除します。