VBA フィルターをかけた可視セルを見出し行を除いて選択する方法

Question

VBAでマクロを組んでいます。
Excelブックが２つあり、一つを仮に「元データブック」もう一つを「参考ブック」と名付けていたとします。

元データブックでVBAを組んでおり、そのVBAで動作をするブックが参考ブックになります。

参考ブックには数千行のデータがあり、そのデータの「リンゴ」と「イチゴ」にフィルターをかけて、必要ない部分を可視セルにし、見出しを除く可視セルを削除後、フィルター解除ということがしたいです。

フィルターはかかりましたし、削除も単品ではできました。
しかし、フィルターをした可視セルを見出し行を除いて削除ができません。

以下２つの方法を試しました。

①フィルターをかけた可視セルを見出し行を除いて選択する
Offsetも使いましたが、A1からI1が見出しで、2行目から6行目がフィルターにより非表示になっているため、動作しませんでした。

②見出し行の次の可視セルのセル番号取得方法
見出し行の次の可視セル番号取得と最終行取得後、SHIFT＋CTRL＋↓をする方法も考えましたが、上記と同様、2行目から6行目がフィルターにより非表示になっているため見出し行の次の可視セルを選択することができませんでした。

どちらかで対処しようと試みましたが、ネットで検索ではVBAを作成しているブックと動作ブックが同じ時の情報しかなく、困っています。

①フィルターをかけた可視セルを見出し行を除いて選択する
もしくは
②見出し行の次の可視セルのセル番号取得方法
のどちらかをご教示いただきたく思います。

コードの前提は、 sankou =「参考ブックの参考シート」をすでに宣言している状態とお考えいただけると幸いです。

'最終行を取得
gyousu = sankou.Range("A1").End(xlDown).Row

'フィルターをかける
sankou.Range("A1:I" & gyousu).AutoFilter Field:=9, Criteria1:=Array("リンゴ","イチゴ"), Operator:=xlFilterValues

sankou.Range("A1").Resize(Selection.RowsSize - 1).Offset(1, 0).CurrentRegion.SpecialCells(xlCellTypeVisible).Delete

よろしくお願いいたします。

Answer 1

下記でどうでしょう。

With sankou.Range("A1").CurrentRegion
    'フィルターをかける
    .AutoFilter Field:=9, Criteria1:=Array("リンゴ","イチゴ"), Operator:=xlFilterValues
    .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilter 'フィルター解除
End With

実行前

実行後

Comments

[kyun]

ご回答ありがとうございます。
試して見ましたが、
実行時エラー 1004
該当するセルが見つかりません
とエラーが出ました。

[hatena19]

当方のサンプルではエラーなく動作しました。
エラーがでるシートの画像をアップしてもらうと原因がわかるかも。

[kyun]

思うように動きました！
本当にありがとうございました！

Answer 2

おおむねこのURLで解決しそうですか？
絞り込んだ結果の行を操作する

A列を"田中"で絞り込み、絞り込んだ結果の行全体を削除します。

Sub Macro2()
    Range("A1").AutoFilter 1, "田中"
    With Range("A1").CurrentRegion.Offset(1, 0)
        .Resize(.Rows.Count - 1).EntireRow.Delete
    End With
End Sub

EntireRowは行全体のRangeを返すプロパティなのでここがキモになりそうですかね

追記
リンク先のコードは正常に動作したのと下記コードでも想定通りの動作になりました。
エラーが出る場合は別の所が原因のようにも見えます。

Sub main()

Dim sankou As Worksheet
Set sankou = ThisWorkbook.ActiveSheet

'最終行を取得
Dim gyousu
gyousu = sankou.Range("A1").End(xlDown).Row

'フィルターをかける
sankou.Range("A1:I" & gyousu).AutoFilter Field:=9, Criteria1:=Array("リンゴ", "イチゴ"), Operator:=xlFilterValues
　　'With Range("A1")だとA列にデータがない場合全部消してしまうのでここだけ変更。
    With Range("I1").CurrentRegion.Offset(1, 0)
        .Resize(.Rows.Count - 1).EntireRow.Delete
    End With
End Sub

Comments

[kyun]

このページは私も閲覧し、試しましたがエラーで動きませんでした。

Answer 3

CurrentRegionの位置が違うような気がします。

'sankou.Range("A1").Resize(Selection.RowsSize - 1).Offset(1, 0).CurrentRegion.SpecialCells(xlCellTypeVisible).Delete
sankou.Range("A1").CurrentRegion.Resize(Selection.RowsSize - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete

Comments

[kyun]

業務時間が終わりましたので、明日試してみます。

[kyun]

試して見ましたが、
実行時エラー438
オブジェクトは、このプロパティまたはメゾットをサポートしていません。
と表示されました。

[radames1000]

Selection.RowSizeにしているからですね。
他の方の回答でいいと思います。