VBA オートフィルタ後の可視セルに色付け(動画あり)

エクセルマクロで、オートフィルタ後の可視セルに色付けするVBAコードをご紹介します。

このページのマクロコードは、コピペで使えます。
ぜひお試しください！

オートフィルタ後の可視セルに色付け

以下のExcelVBAを実行すると、オートフィルタ後のセルに色付けします。

Sub オートフィルタで絞り込んだセルに色を付ける()

    'フィルターでデータ抽出
    Range("A1").CurrentRegion.AutoFilter _
        Field:=3, _
        Criteria1:="埼玉県"

    'オートフィルタ後の可視セルに色付け
    Range("A1").CurrentRegion.Offset(1, 0).Resize(Range("A1"). _
        CurrentRegion.Rows.Count - 1).Interior.Color = 65535

End Sub

マクロ実行後

オートフィルタで絞り込んだデータの背景に色を塗りました。

1行目の見出し以外のセルに着色します。

オートフィルタを解除後も色を保持します。

オートフィルタ抽出結果に色付け（応用）

以下のExcelVBAを実行すると、オートフィルタ抽出結果に色付けします。

Sub オートフィルタで絞り込んだ値に色を付ける()

Dim Target(3) As String
Dim i As Long
Dim MyRow As Long
Dim LastRow As Long

    '対象文字列を変数に格納
    Target(1) = "埼玉県"
    Target(2) = "東京都"
    Target(3) = "広島県"
    
    MyRow = Range("A1").CurrentRegion.Rows.Count - 1
    
    For i = 1 To 3
    
        'フィルターでデータ抽出
        Range("A1").CurrentRegion.AutoFilter _
            Field:=3, _
            Criteria1:=Target(i)
            
        '最終行を取得
        LastRow = Cells(Rows.Count, 1).End(xlUp).Row
        
        '抽出データが1件以上だったら処理実行
        If LastRow > 1 Then
            
            'オートフィルタ抽出結果に色付け
            Select Case i  
                Case 1
                   Range("A1").CurrentRegion. _
                      Offset(1, 0).Resize(MyRow).Interior.Color = 65535
                
                Case 2
                   Range("A1").CurrentRegion. _
                       Offset(1, 0).Resize(MyRow).Interior.Color = 49407
                
                Case 3
                   Range("A1").CurrentRegion. _
                       Offset(1, 0).Resize(MyRow).Interior.Color = 5287936
            End Select
        End If
        
        'フィルタ解除
        On Error Resume Next
            ActiveSheet.ShowAllData
        On Error GoTo 0
    Next i
    
End Sub

マクロ実行後

For文を使用し、オートフィルタでデータ抽出する作業を繰り返します。

その際に、オートフィルタ後の可視セルに色付けします。

オートフィルタ解除後も色を保持します。

 
 
この記事がお役に立ちますと幸いです。
 
・【エクセルマクロ】オートフィルタ処理を自動化する使用例まとめ
 

【エクセルマクロ】オートフィルタ処理を自動化：超便利28選

...

kirinote.com

2022.11.12