絞り込んだ結果をコピーする

  1. Home
  2. Excel
  3. VBA
  4. Excel VBA Tips

大量のデータを絞り込むには、オートフィルタが便利です。ここでは、VBAからオートフィルタを使い倒すテクニックをご紹介します。なお、ボリュームがありますので、以下の項目にページを分けて解説します。なお、ここで解説するオートフィルタは、通常のワークシートに設定されているとします。テーブルでオートフィルタを操作するときは、また別の考え方が必要です。VBAでテーブルを扱う方法に関しては「VBAでテーブルの操作」をご覧ください。

  1. 書き方の基本
  2. 文字列で絞り込む
  3. 数値で絞り込む
  4. 日付で絞り込む
  5. 色で絞り込む
  6. 作業列で絞り込む
  7. 絞り込んだ結果をコピーする (←このページ)
  8. 絞り込んだ結果を集計する
  9. 絞り込んだ結果の行を操作する
  10. オートフィルタの状況を判定する
  11. 数式のエラーで絞り込む

既存の別シートへコピーする

下図のような表を例に解説します。

表はアクティブシートにあります。この表を「A列が"田中"である」で絞り込み、その結果を既存の[Sheet2]へコピーします。コピー先は、次のようになります。

まずは「A列が"田中"である」で絞り込みます。

Sub Macro1()
    Range("A1").AutoFilter 1, "田中"
End Sub

これをコピーするのですが、A列に"田中"が何件あるかは、やってみなければ分かりません。ということは、コピー元のセル範囲を、アドレスで決め打ちはできないということです。何件あるか分からないのですから。なので、ここではコピー元を「どこのセルからどこのセルまで」ではなく「ひとかたまりのセル範囲全部」と指定します。

それには、CurrentRegionプロパティを使います。

Sub Macro1()
    Range("A1").AutoFilter 1, "田中"
    Range("A1").CurrentRegion.Copy Sheets("Sheet2").Range("A1")
End Sub

CurrentRegionは「どこかのセル.CurrentRegion」と書いて、指定した「どこかのセル」を含むひとかたまりのセル範囲を返します。表の中で「Ctrl + Shift + *」を押したのと同じ状態です。

さて、コピーが終わったら、もう元の表を絞り込んでおく必要はありません。なので、こうした場合、一般的には最後でオートフィルタを解除します。▼ボタンも消します。それには次のように、AutoFilterメソッドの引数を何も指定しないで実行します。

Sub Macro1()
    Range("A1").AutoFilter 1, "田中"
    Range("A1").CurrentRegion.Copy Sheets("Sheet2").Range("A1")
    Range("A1").AutoFilter
End Sub

もし、絞り込みは解除するものの、▼ボタンは表示させたままの状態にしたいときは、次のように引数Fieldだけを指定します。

Sub Macro1()
    Range("A1").AutoFilter 1, "田中"
    Range("A1").CurrentRegion.Copy Sheets("Sheet2").Range("A1")
    Range("A1").AutoFilter 1
End Sub

これでうまくいきますが、コード中に同じ「Range("A1")」が3回も登場するのでメンテナンス性が悪いです。もしこれがアクティブシートではなかったら、次のように、すべてのRange("A1")にシートを指定しなければなりません。

Sub Macro1()
    Sheets("Sheet1").Range("A1").AutoFilter 1, "田中"
    Sheets("Sheet1").Range("A1").CurrentRegion.Copy Sheets("Sheet2").Range("A1")
    Sheets("Sheet1").Range("A1").AutoFilter
End Sub

面倒くさいですね。面倒くさいということは、ミスをする可能性が高いということです。なのでこんなときは、Withでくくります。

Sub Macro1()
    With Range("A1")
        .AutoFilter 1, "田中"
        .CurrentRegion.Copy Sheets("Sheet2").Range("A1")
        .AutoFilter
    End With
End Sub

非表示セルはコピーされない

今のコードを見て「え？それでいいの？」って感じた方はいませんか？「可視セルを選択しないでいいの？」って。

確かに、上図の状態では、隠れている(非表示になっている)"田中"ではないセルたちも、選択されています。確認してみましょう。

Sub Macro2()
    With Range("A1")
        .AutoFilter 1, "田中"
        MsgBox .CurrentRegion.Address
        .AutoFilter
    End With
End Sub

ね、CurrentRegionが返すセル範囲には、セルC11も含まれています。これって、隠れている非表示セルですよね。一般的に、こうした非表示セルが含まれている場合、そのセル範囲に何かをすると、見えているセルだけでなく、隠れている非表示セルにまで影響が及ぶと誤解している人が多いです。そんなことないんですよ。マクロだと画面の変化が分かりにくいですから、ここからは手動操作でお見せします。

まずは「A列が"田中"である」で絞り込んだ状態です。

アクティブセルをセルA1に移動して「Ctrl + Shift + *」を押します。ここで選択されるのが、Range("A1").CurrentRegionです。

さあ、ここからです。よく見てくださいね。この選択しているセル範囲をコピーします。Ctrl + Cを押しました。

分かりますか？コピー範囲を表す点滅が、外枠ではなく、表の内部に表示されているでしょ。試しに、この状態で、今は非表示になっている4行目や7行目を表示してみましょう。

違いが分かりにくいですか？画面をもっと拡大してみましょう。

この「オートフィルタで絞り込んだ結果"全体"をコピーすると、Excelは"表示されているセル"だけをコピーする」という特性を、しっかり覚えておいてください。実はコピーだけでなく「オートフィルタで絞り込んだ結果"全体"に対して何かをすると、Excelは"表示されているセル"だけを処理する」というのは、けっこう奥が深い話です。見えていない非表示のセルに影響を及ぼす操作がひとつだけあるのですが、そのへんの解説をすると長くなるので、また別の機会に詳しく書きます。ちなみに、このようにExcelがうまくやってくれるようになったのは、Excel 2002からです。その前は、毎回可視セルを選択しなければなりませんでした。

タイトルを除いた実データだけコピーする

オートフィルタで絞り込んだ結果をコピーするとき、次のコードが最も簡単な方法のひとつです。

Sub Macro1()
    With Range("A1")
        .AutoFilter 1, "田中"
        .CurrentRegion.Copy Sheets("Sheet2").Range("A1")
        .AutoFilter
    End With
End Sub

ただし、これでは"タイトル行"も一緒にコピーされてしまいます。既存データの下に今回のデータをコピー(追記)するようなときは、タイトル行をコピーしたくありません。

実務では、よくある話です。これを実現するには、いくつかの方法があります。ここでは、簡単なやりかたを2つご紹介します。

方法1：Excelおまかせ法

先にも書いたとおり、Excelは「オートフィルタで絞り込んだ結果"全体"をコピーすると、"表示されているセル"だけをコピーする」という特性があります。なので、それを利用します。この方法でいけるのなら、この考え方が簡単です。

「A列が"田中"である」で絞り込んだ状態で、Range("A1").CurrentRegionは"ひとかたまりのセル範囲"を返します。これ実際には、次のように非表示セル(行)も含まれています。

この範囲をアドレスで表すと、Range("A1:C11")です。

このRange("A1:C11")は、Range(左上セル, 右下セル)という書き方で表すと、Range(Range("A1"), Range("C11"))です。

上図をよく見てください。左上セルがRange("A1")だから、タイトル行も含まれるんです。だったら、左上セルをRange("A2")とひとつ下げてやればタイトル行は含まれません。

このとき、左上のRange("A2")は非表示でもいいんです。だって、Excelがうまくやってくれるのですから。あとは、右下であるRange("C11")を特定できれば、タイトル行を除いた実データだけをコピーできます。このRange("C11")というのは、Endモードを使えば分かりますね。

最後に、コピー先をどこにするかです。ここでは、コピー先の[Sheet2]に既存のデータが入力されているとしましょう。このときのコピー先はセルA5です。

こういう追記のコピー先を特定するのは、ある意味"定番"です。しっかり覚えてくださいね。まず、データが入力されている最終セルを特定します。これはEndモードで一発です。

コピー先は、このセルのひとつ下ですから、Offsetです。

Sub Macro3()
    Dim Target As Range, LastCell As Range
    Set Target = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Set LastCell = Cells(Rows.Count, 3).End(xlUp)
    With Range("A1")
        .AutoFilter 1, "田中"
        Range(Range("A2"), LastCell).Copy Target
        .AutoFilter
    End With
End Sub

オブジェクト変数を使わないで書くこともできますが、どうでしょう、可読性が悪くなりますね。私が個人的に書くコードでしたら、こう書いちゃいますw

Sub Macro4()
    With Range("A1")
        .AutoFilter 1, "田中"
        Range(Range("A2"), Cells(Rows.Count, 3).End(xlUp)).Copy _
            Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        .AutoFilter
    End With
End Sub

方法2：自分でResizeしちゃう法

実務で、何かの結果を得るための方法を"ひとつしか知らない"というのは最悪です。もし、万が一その方法を使えないような事態に遭遇したら、そこで試合終了だからです。だから、上記の「Excelおまかせ法」が使えないときのために、別のやり方も覚えといてください。実を言うと、こっちのやり方だったら、さまざまに応用ができます。それは、コピー元のセル範囲を、自分でResizeしちゃう方法です。

Range("A1").CurrentRegionというのは、セルA1を含むひとかたまりのセル範囲です。

ここには、先頭行のタイトルが含まれていますから、そのタイトルをはずして実データだけを特定したいです。

まずは、セルA1を含む全体「Range("A1").CurrentRegion」を、1行下にずらしてやります。

ただ、これでは関係のない、表の下の1行が含まれてしまいます。オートフィルタで扱う表では、一般的にここは何も表示されていないはずです。ですから、このままコピーなどしてもいいのですけど、コピー元とコピー先で書式が異なっていたりすると面倒です。

関係のない最下行を削るには、この範囲の大きさを、1行少なくしてやります。使うのはResizeです。現在の範囲は5行です。この範囲を4行にします。

さて、今指定した「4」とは、どういうことでしょうか。これは、最初の範囲の行数(5行)から1を引いた数です。

行数は、Rows.Countで分かりますね。

まとめると、次のようになります。

セルA1を含む全体が「Range("A1").CurrentRegion」です。これを1行下げたのが「Range("A1").CurrentRegion.Offset(1, 0)」です。この範囲を2回使います。

  1. この範囲の大きさを変える → この範囲.Resize
  2. この範囲の行数を調べる → この範囲.Rows.Count

なので、この範囲をオブジェクト変数に入れておくと分かりやすいです。

Sub Macro5()
    Dim この範囲 As Range
    Range("A1").AutoFilter 1, "田中"
    Set この範囲 = Range("A1").CurrentRegion.Offset(1, 0)
    この範囲.Resize(この範囲.Rows.Count - 1).Copy コピー先
End Sub

ここでは、理解してもらうために"この範囲"という変数名を使いました。実際には、もっとカッコイイ変数名を使ってください。あるいは、私のようにWith派の方は、次のように書くこともできます。

Sub Macro5()
    Range("A1").AutoFilter 1, "田中"
    With Range("A1").CurrentRegion.Offset(1, 0)
        .Resize(.Rows.Count - 1).Copy コピー先
    End With
End Sub

私はこの方がイメージしやすいので、この書き方をしています。

特定の列だけコピーする

ここまでは、タイトル行を含めるかどうかは別にして、いずれにしても「絞り込んだデータ全体」をコピーしてきました。つまり"すべての列"です。そうではなく、特定の列だけコピーするには、どうしたらいいでしょう。ここでも2つの方法をご紹介しますので、状況に応じて使い分けでください。なお、ここでは次のようなケースで解説します。

方法1：不要な列を非表示にする

「オートフィルタで絞り込んだ結果"全体"をコピーすると、Excelは"表示されているセル"だけをコピーする」という特性を思い出してください。

上図の状態でコピーするから下図のようにコピーされるんです。

だったらもし、下図のようにB列が非表示になっていたら、

下図のようにコピーされます。

したがって、今回のように「B列はコピーしたくない」のでしたら、コピーの前に、B列を非表示にしてしまえばいいです。列を非表示にするには、列のHiddenプロパティにTrueを指定します。逆に、非表示の列を再表示させるには、HiddenプロパティにFalseを指定します。

列を特定するには、Columns(2)とかColumns("B")や、Range("B:B")などの書き方がありますが、今回はEntireColumnを使うと便利です。EntireColumnは、任意のセルに対して使い「このセルを含む列全体」を表します。

Sub Macro6()
    Range("B1").EntireColumn.Hidden = True
End Sub


Sub Macro6()
    Range("B1:D1").EntireColumn.Hidden = True
End Sub


Sub Macro6()
    Range("B1,D1").EntireColumn.Hidden = True
End Sub

マクロは、次のような流れです。

  1. A列を"田中"で絞り込む
  2. B列を非表示にする
  3. 絞り込んだ全体をSheet2へコピーする
  4. B列を再表示する
  5. オートフィルタを解除する 
Sub Macro7()
    With Range("A1")
        .AutoFilter 1, "田中"
        Range("B1").EntireColumn.Hidden = True
        .CurrentRegion.Copy Sheets("Sheet2").Range("A1")
        Range("B1").EntireColumn.Hidden = False
        .AutoFilter
    End With
End Sub

方法2：列をひとつずつコピーする

上記の方法は、たくさんある列の中から「この列と、この列はいらない」みたいなときに便利です。でも、絞り込んだ結果の中で「この列と、この列だけコピーしたい」みたいなときは、逆に、非表示にする列の方が多くなっちゃいます。それは面倒ですよね。それに何より、上記の"非表示列"にする方法だと、列の順番を変えることはできません。

こんなときは、コピーしたい列だけをコピーしたいセルにコピーしてやります。ここでも重要なポイントは「オートフィルタで絞り込んだ結果"全体"をコピーすると、Excelは"表示されているセル"だけをコピーする」という特性です。

さて、コピー元はどうやって特定すればいいでしょう。これ、先に解説しています。このコピー元って、要するに「Range(Range("C1"), Cells(Rows.Count, 3).End(xlUp))」ですよね。

Sub Macro8()
    With Range("A1")
        .AutoFilter 1, "田中"
        Range(Range("C1"), Cells(Rows.Count, 3).End(xlUp)).Copy Sheets("Sheet2").Range("A1")
        .AutoFilter
    End With
End Sub

A列も同様です。

Sub Macro8()
    With Range("A1")
        .AutoFilter 1, "田中"
        Range(Range("C1"), Cells(Rows.Count, 3).End(xlUp)).Copy Sheets("Sheet2").Range("A1")
        Range(Range("A1"), Cells(Rows.Count, 1).End(xlUp)).Copy Sheets("Sheet2").Range("B1")
        .AutoFilter
    End With
End Sub

新規シートへコピーする

ここまでは、コピー先の[Sheet2]が、すでに存在しているという前提です。じゃ、コピー先のシートを毎回新しく挿入する場合は。これ、セミナーでよく質問されるケースです。つまり、実務ではみなさんよくやる作業だということですね。基本的な考え方は同じなんですけど、ただ、新しいシートを挿入する系のマクロは注意が必要です。それは、新しいシートを挿入すると必ずアクティブシートが移動するからです。これをイメージできるかどうかにかかっています。

ここでは、上図のようなケースで解説します。A列にはたくさんの名前が入力されています。何人いるかは分かりません。このA列を、存在する名前で順番に絞り込み、その結果を新しいワークシートにコピーします。ついでに、新しいシートの名前も変更しましょうか。いずれにしても、このブックには元データが入力されている[Sheet1]しか存在しないとします。

マクロは、次の流れです。

  1. A列から重複しないリスト(ユニークデータ)を作る
  2. そのリストで順番に絞り込む
  3. 新しいシートを挿入する
  4. 挿入したシートの名前を変更する
  5. 絞り込んだ結果を挿入したシートにコピーする

まずは、重複しないリストを作るところです。これ、もしシート内に空いている列があったら、そこで作るのが簡単です。

Sub Macro9()
    Range("A:A").Copy Range("F1")
    Range("F1").CurrentRegion.RemoveDuplicates 1, xlYes
End Sub

あとは、このF列の名前を使って、オートフィルタの絞り込みを行います。

Sub Macro9()
    Dim i As Long
    Range("A:A").Copy Range("F1")
    Range("F1").CurrentRegion.RemoveDuplicates 1, xlYes
    For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row
        Range("A1").AutoFilter 1, Cells(i, 6)
        ''新規シート挿入
        ''挿入したシートの名前を変更
        ''データのコピー
    Next i
End Sub

ここまでは悩まずに書けると思います。てか、悩まずに書けるようにがんばってくださいw

さて、新規シートの挿入は「Sheets.Add」です。しかしこれだと、アクティブシートの左側に挿入されてしまいます。見栄えが悪いですよね。こんなときは、右端に挿入するようにしましょう。この書き方も"定番"ですから、覚えておくといいです。

Sub Macro9()
    Dim i As Long
    Range("A:A").Copy Range("F1")
    Range("F1").CurrentRegion.RemoveDuplicates 1, xlYes
    For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row
        Range("A1").AutoFilter 1, Cells(i, 6)
        Sheets.Add After:=Sheets(Sheets.Count)
        ''挿入したシートの名前を変更
        ''データのコピー
    Next i
End Sub

さあ、問題はここからです。「Sheets.Add After:=Sheets(Sheets.Count)」を実行すると、新しいシートが挿入されます。すると、挿入したシートがアクティブシートになります。さっきまでアクティブシートだった[Sheet1]はアクティブシートではなくなります。ということは、For Nextの2周目から

Sub Macro9()
    Dim i As Long
    Range("A:A").Copy Range("F1")
    Range("F1").CurrentRegion.RemoveDuplicates 1, xlYes
    For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row
        Range("A1").AutoFilter 1, Cells(i, 6)
        Sheets.Add After:=Sheets(Sheets.Count)
        ''挿入したシートの名前を変更
        ''データのコピー
    Next i
End Sub

下線を引いたRangeとCellsは、アクティブシートのセルではなくなります。だから、最初からシートを指定しておかなければなりません。

Sub Macro9()
    Dim i As Long
    Range("A:A").Copy Range("F1")
    Range("F1").CurrentRegion.RemoveDuplicates 1, xlYes
    For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row
        Sheets("Sheet1").Range("A1").AutoFilter 1, Sheets("Sheet1").Cells(i, 6)
        Sheets.Add After:=Sheets(Sheets.Count)
        ''挿入したシートの名前を変更
        ''データのコピー
    Next i
End Sub

挿入したシートの名前ですが、もし"田中"で絞り込んだのなら"田中"へ、"広瀬"で絞り込んだデータだったら"広瀬"にしたいです。この名前って、Sheet1のF列を順番に見てるんですよね。ここも、シート名をつけて指定します。シート名を変更するのは、挿入した新しいシートです。これって、現在のアクティブシートですよね。

Sub Macro9()
    Dim i As Long
    Range("A:A").Copy Range("F1")
    Range("F1").CurrentRegion.RemoveDuplicates 1, xlYes
    For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row
        Sheets("Sheet1").Range("A1").AutoFilter 1, Sheets("Sheet1").Cells(i, 6)
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Sheets("Sheet1").Cells(i, 6)
        ''データのコピー
    Next i
End Sub

絞り込んだ結果をコピーするところも、今までとは違います。今までは「アクティブシートのセルを、Sheet2へコピー」でしたが、今度は「Sheet1のセルを、挿入したアクティブシートへコピー」です。

Sub Macro9()
    Dim i As Long
    Range("A:A").Copy Range("F1")
    Range("F1").CurrentRegion.RemoveDuplicates 1, xlYes
    For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row
        Sheets("Sheet1").Range("A1").AutoFilter 1, Sheets("Sheet1").Cells(i, 6)
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Sheets("Sheet1").Cells(i, 6)
        Sheets("Sheet1").Range("A1").CurrentRegion.Copy Range("A1")
    Next i
End Sub

これで完成ですが、Sheets("Sheet1")が何度も出てきて可読性が悪いです。これをWithでくくりましょう。

Sub Macro9()
    Dim i As Long
    Range("A:A").Copy Range("F1")
    Range("F1").CurrentRegion.RemoveDuplicates 1, xlYes
    With Sheets("Sheet1")
        For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row
            .Range("A1").AutoFilter 1, .Cells(i, 6)
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = .Cells(i, 6)
            .Range("A1").CurrentRegion.Copy Range("A1")
        Next i
    End With
End Sub

必要であれば、最初に作成した重複しないリスト(ユニークデータ)を消したり、Sheet1のオートフィルタを解除するなどしてください。

ここでは、重複しないリストを作成するのに、RemoveDuplicates(重複の削除)を利用しました。もし、空いている列がないなどの理由で、RemoveDuplicates(重複の削除)を使えないようなら、しかたないですから別の方法を検討してください。参考までに、Collectionを使うやり方のコードだけ書いておきます。

Sub Macro10()
    Dim A As New Collection, i As Long
    On Error Resume Next
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        A.Add Cells(i, 1), Cells(i, 1)
    Next i
    On Error GoTo 0
    With Sheets("Sheet1")
        For i = 1 To A.Count
            .Range("A1").AutoFilter 1, A(i)
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = A(i)
            .Range("A1").CurrentRegion.Copy Range("A1")
        Next i
    End With
End Sub

実務では、このように「重複しないリスト(ユニークデータ)」を作成する機会が多いです。それには、いろいろな方法がありますので、下記を参考にしてください。

重複しないリストを作る(1)

重複しないリストを作る(2)

重複しないリストを作る(3)

重複しないリストを作る(4)

重複しないリストを作る(5)