1. まとめトップ

【VBA】 オートフィルターでの抽出作業【Excel】

オートフィルターでの可視セルのコピーや、絞り込みです。可視セルのみコピーしたい場合や、可視セルのみ数式をコピーしたい場合など様々な場合で使いたいことは多いでしょう!ということでまとめます。(取り急ぎ。 追記予定)

更新日: 2018年01月09日

2 お気に入り 17830 view
お気に入り追加

この記事は私がまとめました

Mochihaさん

VBAその他プログラムまとめ

今回やること

Excel(エクセル)にて絞り込んだ結果のみ可視セルのみコピー、
フィルターをかけたり、フィルターの解除をしたり、
色々と行います。

VBAで可視セルのみ重複なしでリスト化することも可能!

まとめの目次

オートフィルターで絞り込む
絞り込むコツ (完全一致、部分一致(含む)、空白、それ以外)
オートフィルターでの絞り込みを部分解除
オートフィルターの絞り込んだフィルタを全て解除
オートフィルター 可視セルのみ 数式のコピー (FillDown)
オートフィルターの絞り込み、可視セルのみ別シートにコピー
オートフィルターで絞り込んだもの新しいブックに入れたい!

オートフィルターをかける

Range("A1").AutoFilter

こんな感じに、簡単にフィルターをかけることができるよ!

オートフィルターで絞り込む (例)A列を田中で絞り込む!!

Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:="田中"

あるいは、オートフィルタを設定したい表内の、どれか1つのセルを指定すれば、Excelが自動的に表の大きさを認識してくれますので、次のように書いてもOKです。

Range("A1").AutoFilter Field:=1, Criteria1:="田中"

Field:=1  この数字は、
左から何列目かを現した数字になります。

なので、C列の場合は3になります。

Criteria1:="田中"
これは、田中 でフィルターをかけるということ。

絞り込んだ行数を取得する

WorksheetFunction.Subtotal(3, .Range("A:A"))

A列の行数を取得する。絞り込めている可視行を表示します。
これが1の場合は、何も絞り込めていない(当てはまるものはナシ)
If WorksheetFunction.Subtotal(3, .Range("A:A"))=1 then
  Msgbox "絞り込めなかったよ"
End if

Range(Range("A1"), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible).Count

見出し抜きで考えてます。
TEST=Range(Range("A1"), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible).Count

見出しあり(名前、ID、価格、等のタイトル行あり)の場合は
TEST=1になると、絞り込めた該当項目が無いことになります。

絞りこむコツ

"田中"と等しい
Criteria1:="田中"

"田中"ではない
Criteria1:="<>田中"

部分一致
Criteria1:="東京*"''東京で始まる
Criteria1:="*横浜*"''横浜を含む
Criteria1:="*区"''区で終わる

空欄である
Criteria1:=""
''または
Criteria1:="="

空欄ではない
Criteria1:="<>"

数値の比較
Criteria1:="100"''100と等しい
Criteria1:=">100"''100より大きい
Criteria1:="<=100"''100以下

日付の絞り込み
Criteria1:=">2011/3/31"
Criteria1:=">3月31日"

Excel2003/2007
Criteria1:="<" & DateValue("2018/02/01")
’2018/2/1以前のデータを表示する

オートフィルターを全開に(フィルターを解除)する!

Private Sub フィルター全開()
 With Activesheet
  If .FilterMode = True Then 'フィルターがある場合
   .ShowAllData '全部開く
  End If
 End With
End Sub

オートフィルターの絞り込みを部分的に解除する

Range("A1").AutoFilter Field:=1'1列目のフィルターのみ解除!

オートフィルター 可視セルのみ書き込み

.SpecialCells(xlCellTypeVisible).Copy

可視セルのみをコピーする(値のみをコピー)

【最大行】
MaxRow=Thisworkbook.worksheets("TEST").range("A" & rows.count).end(xlup).row

「TEST」シートのA2:最終行までの可視セルを「Sheet1」シートのA1にコピー
With Thisworkbook
.Worksheets("TEST").Range("A2:A" &MaxRow).SpecialCells(xlCellTypeVisible).Copy _
.Worksheets("Sheet1").Range("A1")
End with

オートフィルター 可視セルのみ 数式のコピー

オートフィルターで絞り込んだもの新しいブックに入れたい!

Sub 絞り込みデータコピー()
Dim Mybook As Workbook
Dim Newbook As Workbook

Set Mybook = ThisWorkbook
 With Mybook.ActiveSheet
   If .FilterMode = True Then 'フィルターがある場合
    .ShowAllData '全部開く
   End If
  .Range("A1").CurrentRegion.AutoFilter Field:=.Range("AZ1").Column, _
  Criteria1:="<>完了"'AZ1が完了じゃないものを絞り込み!
 End With

Set Newbook = Workbooks.Add '新しいブックを作成!
 Application.DisplayAlerts = False '警告ポップアップを出なくする
  Newbook.Worksheets("Sheet2").Delete  'Sheet2を削除
  Newbook.Worksheets("Sheet3").Delete  'Sheet3を削除
 Application.DisplayAlerts = True '警告ポップアップを出るようにする

  Mybook.ActiveSheet.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
  Newbook.Worksheets("Sheet1").Range("A1")
  Newbook.Worksheets("Sheet1").Columns.AutoFit '列幅を自動調整
  Newbook.Worksheets("Sheet1").Rows.RowHeight = 15 '行の高さを15に設定
  Newbook.Worksheets("Sheet1").Range("H3").Select 'H3を選択
  ActiveWindow.FreezePanes = True 'ウィンドウ枠の固定
  
   Mybook.ActiveSheet.Range("A1").CurrentRegion.AutoFilter Field:=Mybook.ActiveSheet.Range("AZ1").Column’新しいブックにフィルターをつける

Newbook.SaveAs Filename:="C:\Users\TESTUSER\Desktop\絞り込みデータ" & Format(date, "yyyymmdd") & ".xls"
 'ファイル名をTESTUSERのDesktopに絞り込みデータ20150520.xls などとして保存
Newbook.Close'閉じる
  
End Sub

Newbook.Worksheets("Sheet1").Columns.AutoFit '列幅を自動調整
  Newbook.Worksheets("Sheet1").Rows.RowHeight = 15 '行の高さを15に設定
  Newbook.Worksheets("Sheet1").Range("H3").Select 'H3を選択
  ActiveWindow.FreezePanes = True 'ウィンドウ枠の固定

この辺は必要ないかと思います。
また、AZなどの部分は変更ください。
(AZの列が何番目かを調べているだけなので、AZをBとかに変えてもらうと、B列でできます)

1 2