1. まとめトップ

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

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

更新日: 2017年07月18日

Mochihaさん

  • このまとめをはてなブックマークに追加
2 お気に入り 6812 view
お気に入り追加

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

今回やること

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

まとめの目次

オートフィルターで絞り込む
絞り込むコツ (完全一致、部分一致(含む)、空白、それ以外)
オートフィルターでの絞り込みを部分解除
オートフィルターの絞り込んだフィルタを全て解除
オートフィルター 可視セルのみ 数式のコピー (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日"

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

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列でできます)

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

1 2





興味があるものいついて書きます。面倒なことが嫌いで効率化が好きです。
気に入ったら「お気に入り」を
良い情報だったら友達と共有して頂けると嬉しいです!
プログラム関連についてもまとめていきます。