| 
    
     |  | ▼UO3 さん: こんにちは
 
 丁寧な解説をつけていただきありがとうございました。
 やりたい事に解説をつけていただくと、次に活かせるので
 本当に助かります。
 
 ありがとうございました!
 
 >▼おにこ さん:
 >
 >▼と■の部分の回答ということですから、ご希望には反しますが。
 >
 >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
 
 |  |