**********************************************
ひとつの列で複数の条件でフィルタリングする作業を自動化するマクロです。
例えばこんな表があるとします。
阿部さんと佐藤さんのデータをフィルタリングしたいときは、
「Name」の列で、阿部さんと佐藤さんにチェックマークを入れます。
すると、阿部さんと佐藤さんだけ表示できます。
この程度のサイズで、条件も３つ程度でしたら手動でも良いと思いますが、
私が扱っている表は 3000行以上あります。
その中からフィルタリングしたいIDが20個近くある場合もあります。
一つずつチェックを入れていくと大変なので、対象のIDを赤字にして、
赤字のセルをフィルタリングするマクロを作りました。
マクロ
’このコードは「個人用マクロブック」の標準モジュールに記述してください
Sub 複数条件でフィルタリング()
Dim r As Long '表の行を格納する
Dim r2 As Long 'フィルタリング対象の行を格納する
Dim c As Long '対象データの列番号を格納する
Dim LastR As Long '表の最終行を格納する
Dim LastR2 As Long '対象データの最終行を格納する
c = Selection.Column 'フィルタリング対象データの先頭行を選択しておく
r2 = Selection.Row 'フィルタリング対象データの先頭行
LastR2 = Cells(Rows.Count, c).End(xlUp).Row 'フィルタリング対象データの最終行
LastR = Cells(Rows.Count, 1).End(xlUp).Row '表の最終行を列Aから取得
'AutoFilter が設定されているかチェック
If ActiveSheet.AutoFilterMode = True Then
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData 'AutoFilterが絞り込まれていたら外す
End If
Else
MsgBox "オートフィルターを設定してください"
End ’オートフィルターが設定されていなければ終了します
End If
'対象データが同じであればフォントを赤にするループ
For r2 = r2 To LastR2
For r = 2 To LastR
If Cells(r, c) = Cells(r2, c) Then
Cells(r, c).Font.ColorIndex = 3
Cells(r2, c).Font.ColorIndex = 3 '対象データも赤字にする
End If
Next r
Next r2
MsgBox "完了"
End Sub
***********************************************
フィルタリングの対象となるデータを、同じ列の下部に貼り付けて、
対象のデータが見つかったら赤字にします。
結果はこんな感じです。
フィルタリング対象データも赤字にすれば存在しないデータの有無もすぐにわかります。
そして、赤字でフィルタリングして、必要なデータだけ絞り込みます。
あとは、いつも通りこのマクロをリボンに登録して、
いつでも、どんなファイルにでも使えるようにしておきます。
**********************************************
個人用マクロブックについてはこちら
リボンに登録についてはこちら
＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／
