オートフィルタで抽出する

このエントリーをはてなブックマークに追加  



指定した条件に一致するデータだけを別のシートに抽出してみましょう。元データが入力されているシートを「Sheet1」、抽出する先のシートを「Sheet2」とします。


「商品コード=A001」のデータだけを Sheet2 に抽出してみます。ここではオートフィルタを使います。

Sub Sample03()
    With Worksheets("Sheet1").Range("A1")
        .AutoFilter Field:=1, Criteria1:="A001"     ''(1)
        .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("Sheet2").Range("A1")    ''(2)
        .AutoFilter     ''(3)
    End With
    Worksheets("Sheet2").Activate
End Sub

(1) Sheet1 のリストにオートフィルタを設定します。オートフィルタを設定する AutoFilterメソッドは、手作業のときと違い設定すると同時にフィルタリングすることができます。引数 Field には「何列目のデータ」を指定します。ここでは A 列の「商品コード」にフィルタをかけますので 1 を指定しました。引数 Criteria1 は「1 番目の条件」を意味します。

(2) フィルタの結果を Sheet2 にコピーします。ここにはいくつかのポイントがあります。フィルタした結果だけをコピー対象にしたいのですが、CurrentRegion プロパティだけでコピー元を特定すると、条件に一致していない(隠れている)セルまでコピーされてしまいます。そこで「可視セル」だけをコピーするために SpecialCells メソッドを使いました。これは、[F5] キーを押して[セル選択]ボタンをクリックし、[選択オプション] ダイアログボックスで「可視セル」だけを表示するのと同じ働きをします。Excel の VBA を使いこなすには、まず Excel の機能を熟知することから始めましょう。Sheet2 にコピーするときも「選択範囲をコピー」→「抽出先を選択」→「貼り付け」のように無駄な(かつ、恥ずかしい)記述は避けましょう。セルをコピーする Copy メソッドは、引数にコピー先を指定できます。

(3) オートフィルタを解除します。



とりあえず抽出はできましたが、見栄えがあまりよくありません。列幅が調整されていないのでデータ切れています。抽出した後、Sheet2の列幅を自動調整するには、Worksheets("Sheet2").Activateの後にColumns("A:D").EntireColumn.AutoFitを追加します。自動調整ではなく、Sheet1 の列幅を引き継ぎたいのでしたら次のようにするといいでしょう。

Sub Sample03_2()
    Dim i As Long
    With Worksheets("Sheet1").Range("A1")
        .AutoFilter Field:=1, Criteria1:="A001"
        .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("Sheet2").Range("A1")
        .AutoFilter
    End With
    For i = 1 To 4
        Worksheets("Sheet2").Columns(i).ColumnWidth = _
        Worksheets("Sheet1").Columns(i).ColumnWidth
    Next i
    Worksheets("Sheet2").Activate
End Sub



オートフィルタの条件を変えることでさまざまな抽出が可能です。次のコードは「3月5日から3月11日の間に納品した」データを抽出します。

Sub Sample03_3()
    With Sheets("Sheet1").Range("A1")
        .AutoFilter Field:=4, Criteria1:=">=3月5日", Operator:=xlAnd, Criteria2:="<=3月11日"
        .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("Sheet2").Range("A1")
        .AutoFilter
    End With
End Sub


このエントリーをはてなブックマークに追加