Office TANAKA - Excel VBA Tips[オートフィルタを使い倒す]

大量のデータを絞り込むには、オートフィルタが便利です。ここでは、VBAからオートフィルタを使い倒すテクニックをご紹介します。なお、ボリュームがありますので、以下の項目にページを分けて解説します。

オートフィルタの結果をコピーする

オートフィルタで絞り込んだ結果は、条件に一致しない行が非表示になっているだけです。なので、合計を計算したり、件数をカウントするときには、ワークシート関数のSUBTOTAL関数を使ったのですが、絞り込んだ結果をコピーするときは、もっと簡単です。表示されているセルだけを、Excelがうまく処理してくれます。

ここでは、結果が分かりやすいように、下図のようなデータを例にします。
元のデータは[Sheet1]に入力されています。このデータに対して、A列を"田中"で絞り込みます。絞り込んだ結果を、[Sheet2]のセルA1にコピーします。

セルをコピーするには、次のようにします。

とりあえず、貼り付け先は、Sheet2のセルA1として考えましょう。

コピー元は、オートフィルタの結果表示されている「ひとかたまりのセル範囲」と考えられます。Excelでは、こうした「ひとかたまりのセル範囲」を簡単に取得する方法があります。手動操作なら「Ctrl + [*]キー」です。アクティブセルを、セルA1に移動して「Ctrl + [*]キー」を押すと、セルA1を含む、ひとかたまりのセル範囲が選択されます。このセル範囲を取得するのが、CurrentRegionプロパティです。オートフィルタの結果によらず、タイトル行のセルA1は必ず表示されているはずですから、コピー元のセル範囲は次のように表されます。

本来、CurrentRegionプロパティは、非表示になっているセルも含まれます。オートフィルタの結果は、条件に一致しないセルが非表示になっているだけですから、CurrentRegionプロパティが返すセル範囲は、オートフィルタの結果にかかわらず、表全体になってしまいます。しかし、オートフィルタの結果に対してCurrentRegionプロパティを使い、さらに、そのセル範囲をコピーすると、Excelが自動的に、表示されているセルだけをコピーしてくれます。

Sub Sample()
    With Sheets("Sheet1").Range("A1")
        .AutoFilter Field:=1, Criteria1:="田中"
        .CurrentRegion.Copy Sheets("Sheet2").Range("A1")
    End With
End Sub

Withステートメントについては、下記のページをご覧ください。

Withって何ですか？

タイトル行を除いてコピーする

一見すると簡単そうに見えるコピーですが、実は意外な処理に手間取ります。下図のように、すでに入力されているセルの下に、オートフィルタの結果をコピーすることを考えてみましょう。

まず、貼り付け先を特定しましょう。新規データの貼り付け先は、既存データの1行下のセルです。これは、Endモードを使えば一発ですね。貼り付け先は次のようになります。

Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

問題はコピー元です。まず、さっきのコードと同じCurrentRegionプロパティを使ってみましょう。

Sub Sample()
    With Sheets("Sheet1").Range("A1")
        .AutoFilter Field:=1, Criteria1:="田中"
        .CurrentRegion.Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
End Sub

実行結果は下図のようになります。失敗です。これは、期待した結果ではありません。

コピー元に、タイトル行は不要です。でも、Range("A1").CurrentRegion は、セルA1を含むひとかたまりのセル範囲ですから、どうしてもタイトル行が含まれてしまいます。

オートフィルタで絞り込んだ結果のうち、タイトル行を除くデータだけをコピーするには、工夫が必要です。ここでは、3つの方法をご紹介します。ただし、3つめは、けっこう難しいです。

方法1：タイトルごとコピーしてからタイトルを削除する

タイトルごとコピーするのなら、Range("A1").CurrentRegionをコピーしてやればいいのですから簡単です。だから、とりあえずタイトルごとコピーして、貼り付けた後で、不要のタイトルだけを削除してやります。

先に、整理しておきましょう。今回のコピー先(貼り付け先)は、セルA5です。このセルは、A列に入力されているデータのうち、最下行のセルの、1つ下のセルです。したがって、EndモードとOffsetを使って、次のように表されます。

では、削除するタイトルは、どこでしょう。タイトルは1行目ですから、上記のように、セルA5にコピーするのなら、セル範囲A5:B5が、削除するべきタイトルになります。セル範囲A5:B5というのは、Resizeプロパティを使うと、次のように表されます。

ところで、このセルA5というのは、コピー先であり、データの最下行の1つ下のセルでした。つまり、削除するセル範囲は、次のようになります。

このように、データの最下行の1つ下のセル(ここではセルA5)は、コピー先の指定と、タイトルを削除するときに使いますので、一度変数に入れておくといいでしょう。

Sub Sample()
    Dim Target As Range
    Set Target = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    With Sheets("Sheet1").Range("A1")
        .AutoFilter Field:=1, Criteria1:="田中"
        .CurrentRegion.Copy Target
    End With
    Target.Resize(1, 2).Delete Shift:=xlUp
End Sub

方法2：別のシートにコピーしてからタイトルを削除する

タイトルごとコピーしてからタイトルを削除するのではなく、先にタイトルだけを削除して、データだけをコピーするやり方です。上の方法に比べて手間がかかりますが、その分、応用が利きます。
オートフィルタで絞り込んだ結果だけをコピーするのは同じです。問題は、コピー先(貼り付け先)です。ここでは、新しいワークシートを1枚挿入して、そこにコピーしてやります。

複数のワークシートをイメージしなければならないので、ビギナーには少々荷が重いかもしれませんが、今回の事例以外にも使える、応用範囲の広い方法です。

Sub Sample()
    Dim Target As Range
    Set Target = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    With Sheets("Sheet1").Range("A1")
        .AutoFilter Field:=1, Criteria1:="田中"
        .CurrentRegion.Copy
        With Worksheets.Add
            .Paste
            .Rows(1).Delete
            .UsedRange.Copy Target
            Application.DisplayAlerts = False
            .Delete
            Application.DisplayAlerts = True
        End With
    End With
End Sub

この方法は、たとえば次のようなケースにも応用できます。
オートフィルタで絞り込む元データが次のような表だったとします。

このデータに対して、[名前]列を"田中"で絞り込み、その結果を[田中]シートにコピーします。ただし、コピーするデータは、[日付]列と[地域]列と[金額]列だけです。

これって、実務ではよくある処理ですよね。このように、オートフィルタで絞り込んだ結果のうち、特定の列だけを別のシートにコピーしたいときも、上でやった「一度別のワークシートにコピーして、不要なセルを削除する」方法を使うと便利です。

Sub Sample()
    Dim Target As Range
    Set Target = Sheets("田中").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    With Sheets("Sheet1").Range("A1")
        .AutoFilter Field:=2, Criteria1:="田中"
        .CurrentRegion.Copy
        With Worksheets.Add
            .Paste
            .Rows(1).Delete         ''タイトル行を削除
            .Columns(4).Delete      ''[商品]列(D列)を削除
            .Columns(2).Delete      ''[名前]列(B列)を削除
            .UsedRange.Copy Target
            Application.DisplayAlerts = False
            .Delete
            Application.DisplayAlerts = True
        End With
    End With
End Sub

もっと実務的に考えたら、きっとこういうデータって、元データに登場する名前ごとに、データを分解してコピーしたいのでは？今回のサンプルでいえば、[田中]だけでなく、[鈴木]も[山田]も専用のワークシートがあって、それぞれにコピーしたい、みたいな。今日は気分がいいので、特別にそのサンプルもご紹介しちゃいましょう。

Sub Sample()
    Dim Target As Range, Member As Variant, i As Long
    Member = Array("田中", "鈴木", "山田")
    For i = 0 To UBound(Member)
        Set Target = Sheets(Member(i)).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        With Sheets("Sheet1").Range("A1")
            .AutoFilter Field:=2, Criteria1:=Member(i)    ''2列目(B列)を3人の名前で順に絞り込む
            .CurrentRegion.Copy
            With Worksheets.Add
                .Paste
                .Rows(1).Delete         ''タイトル行を削除
                .Columns(4).Delete      ''[商品]列(D列)を削除
                .Columns(2).Delete      ''[名前]列(B列)を削除
                .UsedRange.Copy Target
                Application.DisplayAlerts = False
                .Delete
                Application.DisplayAlerts = True
            End With
        End With
    Next i
End Sub

こんな感じです。なお、各人の名前がついたワークシートは、必ず存在するものとします。

方法3：共有セル範囲の参照を使う

方法1と方法2で、タイトルごとコピーしてからタイトルを削除するやり方と、一度別のワークシートにコピーしてからタイトルを削除する方法をご紹介しました。基本的には、この2つがオススメです。特に、一度別のワークシートにコピーする方法は、応用範囲が広いので、ぜひマスターしてください。しかし、何らかの事情で、どちらの方法も使えないのなら(そんなことはないと思いますけど)、とっておきの方法をご紹介します。先に言っておきますが、これはかなり難しいです。

これには、共有セル範囲の参照を使います。まずは、簡単な例で動作をイメージしてください。

上図は、セル範囲B4:D4と、セル範囲C2:C6を選択したところです。この2つのセル範囲で共有しているセルは、交差しているセルC4です。このように、複数のセル範囲で、共有しているセルを取得するには、ApplicationオブジェクトのIntersectメソッドを使います。

Sub Sample()
    Dim Target As Range
    Set Target = Application.Intersect(Range("B4:D4"), Range("C2:C6"))
    MsgBox Target.Address
End Sub

これが、Intersectメソッドの働きです。

ここまでは、よろしいですか？
では次に、オートフィルタで絞り込んだ結果を考えてみましょう。オートフィルタで絞り込んだ結果というのは、条件に一致しないセル(行)が非表示になっているだけです。

CurrentRegionプロパティは、あるセルを含む連続したセル範囲を返します。これは、キーボードでCtrl + [*]キーを押したのと同じ状態です。この、連続したセル範囲とは、非表示のセルも含みます。つまり、オートフィルタで絞り込んだ結果に対してCurrentRegionプロパティを使うと、元データがすべて選択されます。

Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
Range("A1").CurrentRegion.Select

CurrentRegionプロパティは、非表示になっているセルも含みます。ここから、表示されているセルだけを取得するには、SpecialCellsメソッドを使います。SpecialCellsメソッドは、[選択オプション]ダイアログボックスで特定のセルを選択するのと同じ機能です。

あるセル範囲内で、表示されているセルだけを取得するには、引数に、定数xlCellTypeVisibleを指定します。先のCurrentRegionプロパティと、このSpecialCellsメソッドを使うと、オートフィルタで絞り込んだ結果、表示されているセルだけを取得できます。

Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select

さあ、ここまではよろしいですか？
Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
とすることで、オートフィルタで絞り込んだ結果を取得することができるわけです。たとえば、"土屋"で絞り込んだ結果なら

"田中"で絞り込んだ結果なら

ということです。

いずれにしても、タイトル行が含まれていますね。ここでは、こうして選択される範囲から、タイトル行を除いたセル範囲を取得したいんです。

ここで登場するのが、最初にご紹介した「共有セル範囲の参照」です。上図左の、オートフィルタで絞り込んだ結果と、セル範囲A2:B9の共有セル範囲が、上図右の、今回欲しいセル範囲になります。

さて、セル範囲A2:B9とは、いったい何でしょう。これは「オートフィルタの対象範囲であるA1:B9から、1行目(タイトル行)を除いた」セル範囲です。オートフィルタの対象範囲は、AutoFilterオブジェクトのRangeプロパティで取得できます。

MsgBox ActiveSheet.AutoFilter.Range.Address

言うまでもありませんが、オートフィルタの対象範囲は、データによって変動します。右下の最終セルが、いつもB9とは限りません。そうした可変のデータ範囲でも対応できる方法を考えます。

まずは、セルのアドレスが固定の場合で考えてみます。この対象範囲は、セル範囲A1:B9ですね。

Rangeプロパティで表すと、Range("A1:B9")です。しかし、Rangeプロパティには、2番目の書式があります。

Range(左上のセル, 右下のセル)

この2番目の書式で表すと、Range("A1:B9")は、Range(Range("A1"), Range("B9"))と表せます。

"あるセル範囲"の左上セルは、次のように表されます。

あるセル範囲.Cells(1)

あるいは、

あるセル範囲(1)

と書くこともできます。では、"あるセル範囲"の右下セルは、どうでしょう。これは、2通りの方法で特定できます。

あるセル範囲(あるセル範囲.Count)

"あるセル範囲"の右下セルとは、"あるセル範囲"内で最後のセルです。もし、"あるセル範囲"にセルが18個あるなら、あるセル範囲(18)ということです。この「18」とは、"あるセル範囲"に含まれるセルの個数ですから、Countプロパティで取得できます。したがって、あるセル範囲(あるセル範囲.Count)ということです。
もうひとつの特定方法は、

あるセル範囲.SpecialCells(xlCellTypeLastCell)

です。 [選択オプション]ダイアログボックスでは、「最後のセル」を指定することもできます。

引数は、xlCellTypeLastCellです。

まとめると、左上セルと右下セルは、次のような取得方法があります。

【左上セル】
・あるセル範囲.Cells(1)
または
・あるセル範囲(1)

【右下セル】
・あるセル範囲(あるセル範囲.Count)
または
・あるセル範囲.SpecialCells(xlCellTypeLastCell)

ここでは、次の方法で、左上セルと右下セルを特定します。

左上セル → あるセル範囲(1)
右下セル → あるセル範囲(あるセル範囲.Count)

なお、右下セルを特定する「あるセル範囲.SpecialCells(xlCellTypeLastCell)」は、オートフィルタで絞り込まれた結果に対して使うと、表示されている右下セルが返ります。今回のケースでは、これでも目的を達成できますが、オートフィルタの(絞り込まれる前の)対象範囲の右下セルを確実に特定するために、「あるセル範囲(あるセル範囲.Count)」を使うことにしました。

さて、このセル範囲A1:B9って、何でしたっけ？そう、オートフィルタの対象セル範囲でしたね。このセル範囲は、AutoFilter.Range で取得できるのでした。このAutoFilter.Rangeを使って表すと、左上セルと右下セルは、次のようになります。

ここまでくれば、もう一息です。いま特定したいセル範囲は、このセル範囲全体から、1行目を除いたセル範囲です。つまり、左上のセルを、ひとつ下に下げてやればいいです。

この左上セルと右下セルを、Range(左上セル, 右下セル)に当てはめると、次のようになります。なお、式が長くなるので割愛していますが、本当は「ActiveSheet.AutoFilter.Range」のようにワークシートを指定しなければなりません。

Range(AutoFilter.Range(1).Offset(1, 0), AutoFilter.Range(AutoFilter.Range.Count))

これで役者は揃いました。

まず、A(オートフィルタで絞り込んだ結果)を取得します。

Sub Sample()
    Dim A As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    Set A = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
End Sub

次に、B(オートフィルタの対象範囲－1行目)を取得します。下のコードでは、式が長くなるので、ActiveSheet.AutoFilterをWithでくくっています。

Sub Sample()
    Dim A As Range, B As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    With ActiveSheet.AutoFilter
        Set A = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        Set B = Range(.Range(1).Offset(1, 0), .Range(.Range.Count))
    End With
End Sub

AとBの共有範囲が、目的のセル範囲です。

Sub Sample()
    Dim A As Range, B As Range, Target As Range
    Range("A1").AutoFilter Field:=1, Criteria1:="土屋"
    With ActiveSheet.AutoFilter
        Set A = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
        Set B = Range(.Range(1).Offset(1, 0), .Range(.Range.Count))
    End With
    Set Target = Application.Intersect(A, B)
    MsgBox Target.Address
End Sub

ふう～長かった・・・

今回のテーマは「タイトル行を除くデータだけを、別シートの末尾にコピーする」ですから、一応書いておきますが、最後のMsgBox Target.Addressを、

Target.Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

にすれば、Sheet2の最下行にコピーできます。

オートフィルタの結果の特定列だけを操作する >> 次ページ