エクセルＶＢＡのオートフィルタについて

Question

オートフィルタ後の範囲選択で教えてください。

１行目にタイトルがある表で
Range("a1").AutoFilter Field:=2, Criteria1:="ＰＣ"
Range("A1").CurrentRegion.Select

と実行すると１行目のタイトル行を含めて商品がＰＣの行が
セレクトされます。
オートフィルタを何度も実行した結果を別シートにまとめる為
２回目以降はタイトル行を含めずにセレクトしたいのですが
やり方がわかりません。お知恵をお貸しください。

pauNed · Accepted Answer

こんにちは。

.AutoFilter.Rangeを使っても良いかもしれません。
また、抽出対象がない時、見出し行を含まずコピーすると、
非表示データ全部がコピーされてしまいますから、気をつけたほうが良いと思います。

With ActiveSheet
　　If .AutoFilterMode Then
　　　　With .AutoFilter.Range
　　　　　　If WorksheetFunction.Subtotal(3, .Columns(1)) > 1 Then
　　　　　　　　Intersect(.Cells, .Offset(1)).Copy _
　　　　　　　　　　Destination:=Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
　　　　　　End If
　　　　End With
　　End If
End With

ka_na_de · Answer

ka_na_deです。

質問者さん以外にコメントすることは極力控えているのですが、
Wendy02さんの回答を拝見して、どうしてもコメントしたくなりました。

すごいです。
見ればみるほど雲が晴れていきます。
なるほどー。こう書くのかー。
遊びでEXCELをいじり始めて２ヶ月ですが、
本当に奥が深いですね。
自分もこんな風にすっきり書きたいのですが、
まだまだ未熟なせいでエラーと格闘しながら
対処療法で記述しているのが現状です。

これからも、勉強させてください。
ありがとうございました。

（rex9200さん　横道にそれてごめんなさいね。）

Wendy02 · Answer

こんばんは。

すでに、回答は出ていますが、私の書いたポイントをまとめておきます。


Dim r As Range
Dim Dest As Range
Set Dest = Worksheets("Sheet2").Range("A1") '貼り付け先
With Worksheets("Sheet1") 'オートフィルタのあるシート
　.Range("A1").AutoFilter Field:=2, Criteria1:="PC" '検索値
　Set r = .AutoFilter.Range
　
　If IsEmpty(Dest) Then r.Rows(1).Copy Dest　'タイトルコピー
　
　'ここで、Visible のセルをカウントする
　If r.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　
　'これで見えるものだけのコピーは出来る
　　r.Offset(1).Resize(r.Rows.Count - 1).Copy _
　　 Dest.Parent.Range("A65536").End(xlUp).Offset(1)
　End If　
End With
　Set r = Nothing
　Set Dest = Nothing

ka_na_de · Answer

＃１です。

Ｎｏ１の回答で選択後に手動でコピー＆ペーストができたので、
tbl.Rows.Countの値を使わずにコピーしていくマクロを作ってみました。
本来は他の回答者さんのようにきちんと選択しないといけないのでしょうが・・・
難しかったので、場当たり的に作ってしまいました。ご参考までに。

Sheet1に表があって、２列目をＰＣ,aaa,bbb,cccの項目で抽出して
空白シートのSheet2へ並べていく例です。

Sub test()
　Dim ITEM
　Dim i As Integer
  
　'抽出する項目
　ITEM = Array("ＰＣ", "aaa", "bbb", "ccc")
 
　'Sheet1の見出し行をSheet2へコピー
　Worksheets("Sheet1").Rows("1:1").Copy _
　　　Destination:=Worksheets("Sheet2").Rows("1:1")
 
　'Sheet1の表の２列目で項目を抽出後、Sheet2のデータ末尾にコピー
　For i = LBound(ITEM) To UBound(ITEM)
　　Call filter_copy("Sheet1", 2, ITEM(i), "Sheet2")
　Next i

End Sub


Public Function filter_copy(Sheet_1 As String, field_NO As Integer,  _
　　　　　　　　　　　　name As Variant, Sheet_2 As String)
　Dim tbl As Object
 
　Worksheets(Sheet_1).Select
　Range("A1").AutoFilter Field:=field_NO, Criteria1:=name
　Range("A1").Select
 
　Set tbl = ActiveCell.CurrentRegion
　tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select

　Selection.Copy _
　　　Destination:=Worksheets(Sheet_2).Cells(65536, "A").End(xlUp).Offset(1, 0)

End Function

ka_na_de · Answer

おはようございます。

エラーは一旦解決されたようですね。

＃１のマクロ実行後、手動でコピー＆ペーストして
問題なかったので、これでよしと回答してしまいました。

選択後に、次の処理でtbl.Rows.Countの値を使って、
余計な行が張り付いたのでしょうね。

だとすると、Wendy02が回答しているように、
SpecialCells で、xlCelltypeVisible の条件でカウントする必要があると思います。

なお、pauNedさんの回答のIntersectは初めて知りました。
勉強になります。これから調べてみようと思います。


尚、すべて解決された折は、最終形を公開していただけたら幸いです。
勉強させていただきたいので、よろしくお願いします

Wendy02 · Answer

こんばんは。

横からすみません。

tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select

仮に、
tbl.Rows.Count - 1
　↑
ここが、1 になることはありえませんが、仮に、ここが、1でも、Resizeには、-1　にならなければ、そのような、「実行時エラー」は出ません。エラーの原因は、大方、別のシートモジュールに書いているせいではないでしょうか？正しいシートモジュールか、標準モジュールに貼り付けているのでしょうか？なお、行数を取るのでしたら、SpecialCells で、xlCelltypeVisible の列ひとつのセルを数えるのだとは思います。

ka_na_de · Answer

tbl.Rows.Count =1
になっているということは、見出し行しか存在せず、
データがまだ入力されていないということでしょうか？

もし、そのような場合が存在するのなら、
以下でどうですか？
もちろんデータが無いのでリサイズしません。（見出しのみ選択）

Sub test()

Range("a1").AutoFilter Field:=2, Criteria1:="ＰＣ"
Range("A1").CurrentRegion.Select

Set tbl = ActiveCell.CurrentRegion
If tbl.Rows.Count = 1 Then Exit Sub
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select

End Sub

ka_na_de · Answer

これでどうですか？

Sub test()

Range("a1").AutoFilter Field:=2, Criteria1:="ＰＣ"
Range("A1").CurrentRegion.Select

Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select

End Sub
コードはヘルプから抜粋しました。

エクセルＶＢＡのオートフィルタについて

こんにちは。

この回答への補足

ka_na_deです。

この回答への補足

こんばんは。

＃１です。

おはようございます。

こんばんは。

tbl.Rows.Count =1

これでどうですか？

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング