| 
    
     |  | ▼おにこ さん: 
 ▼と■の部分の回答ということですから、ご希望には反しますが。
 
 Sub TEST()
 Dim r As Range
 
 ActiveSheet.AutoFilterMode = False   '念のため解除
 
 Range("A1").CurrentRegion.AutoFilter  'オートフィルター設定
 With ActiveSheet.AutoFilter.Range
 Set r = .Resize(.Rows.Count - 1, 14).Offset(1) 'タイトル行を除いた領域
 r.Interior.ColorIndex = xlNone       'まず、色を消して
 .AutoFilter Field:=14, Criteria1:="2"    'オートフィルター実行
 '抽出された時のみ色付け
 If WorksheetFunction.Subtotal(103, .Columns(14)) > 1 Then r.Interior.ColorIndex = 6
 End With
 
 ActiveSheet.AutoFilterMode = False   'オートフィルター解除
 
 End Sub
 
 |  |