条件に合う行だけを別シートに抽出する（オートフィルターの使い方）

どんな場面で使うか

全社の受注明細から自分の担当分だけを抜き出す、未入金のデータだけを別シートにまとめる、といった作業です。ループで1行ずつ判定して書き出す方法もありますが、Excel のオートフィルター機能をマクロから使うと、少ないコードで速く処理できます。

基本の流れ

抽出は次の4つの手順で行います。最後にフィルターを解除し忘れると、元のシートが絞り込まれたまま残るので注意します。

1. 表の範囲にオートフィルターをかけ、条件を指定する
2. 見えているセル（SpecialCells(xlCellTypeVisible)）だけをコピーする
3. 貼り付け先のシートに貼る
4. フィルターを解除する

コード（担当者と金額の2条件）

C列の担当者が「佐藤」で、E列の金額が10万円以上の行を「抽出結果」シートに書き出します。該当する行が1件もないとき、SpecialCells はエラーになるため、先に件数を確認しています。

Sub ExtractRows()
    Dim ws As Worksheet, outWs As Worksheet, rng As Range
    Dim lastRow As Long, hit As Long

    Set ws = ThisWorkbook.Worksheets("受注明細")
    Set outWs = ThisWorkbook.Worksheets("抽出結果")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set rng = ws.Range("A1:F" & lastRow)          ' 1行目は見出し

    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    rng.AutoFilter Field:=3, Criteria1:="佐藤"
    rng.AutoFilter Field:=5, Criteria1:=">=100000"

    hit = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1   ' 見出しを除く
    outWs.Cells.Clear
    If hit > 0 Then
        rng.SpecialCells(xlCellTypeVisible).Copy outWs.Range("A1")
    End If
    ws.AutoFilterMode = False
    MsgBox hit & " 件を抽出しました"
End Sub

日付の範囲で絞り込む

日付の条件は、文字列ではなく日付のシリアル値で指定すると確実です。次の例は、B列の受注日が今月の行を抽出します。Criteria1 と Criteria2 を Operator:=xlAnd で組み合わせます。

Dim d1 As Date, d2 As Date
d1 = DateSerial(Year(Date), Month(Date), 1)
d2 = DateSerial(Year(Date), Month(Date) + 1, 0)
rng.AutoFilter Field:=2, Criteria1:=">=" & CLng(d1), Operator:=xlAnd, Criteria2:="<=" & CLng(d2)

注意点

表の途中に空白行があると、オートフィルターの範囲がそこで切れてしまうことがあります。この記事のように範囲を最終行まで明示して指定すると安全です。

また、シートの保護がかかっているとフィルターを操作できません。保護を解除してから実行するか、フィルターの使用を許可した状態で保護してください。条件が複雑になる場合（3つ以上の値のいずれか、など）は、Criteria1 に配列を渡して Operator:=xlFilterValues を指定する方法もあります。

• 範囲は最終行まで明示して指定する
• 該当0件のときの SpecialCells エラーに備える
• 最後に AutoFilterMode = False で解除する

ほかの記事