VBA オートフィルタ後 非表示行の削除

Question

VBAにて オートフィルタでデータを抽出した後　非表示行を削除したいです。
ご教示お願い致します。

★前提
ワークシート【データ移行】　生データのシートです、オートフィルタでデータを抽出します。
ワークシート【A】　抽出データのみを表示させたいシートです。

下記のような考え方でコードを書いています。
①オートフィルタでデータを抽出
②抽出データを　シート【A】に移行
③シート【A】の行を上から確認していき、非表示の行は消去する

★困っていること
非表示の行が削除されずに残っている

実際のコードは以下の通りです。

コードVBA
'任意の期間のデータのみオートフィルタで抽出

Dim AD1 As Date
Dim AD2 As Date

AD1 = TextBox3.Value
AD2 = TextBox4.Value

Worksheets("データ移行").Select
Worksheets("データ移行").Range("A2").AutoFilter field:=1, Criteria1:=">=" & AD1, Operator:=xlAnd, Criteria2:="<=" & AD2


'抽出した結果をAシートに移行

 Sheets("データ移行").Copy AFTER:=Worksheets("B")
 ActiveSheet.name = "A"
 
'オートフィルターを解除
 Worksheets("データ移行").Select
 Worksheets("データ移行").Range("A2").Select
 Selection.AutoFilter
 
 
'オートフィルタで非表示になっている行を削除
 Worksheets("A").Select
 Dim AFN As Long
 Dim iAA As Long
 
 AFN = Worksheets("データ移行").Cells(Rows.Count, 1).End(xlUp).Row
 
 For iAA = 2 To AFN
    If Worksheets("A").Rows(iAA).Hidden Then Worksheets("A").Rows(iAA).Delete
    
 Next iAA

Answer 1

何かにつけてDictionaryを使ってしまう私は、こんな感じで書いてみたりします。
（まとめて消すから早い？ そうでもない？）

Dim d As Object ' As Scripting.Dictionary
Set d = CreateObject("Scripting.Dictionary")
Dim ws As Worksheet, r As Range
Set ws = Worksheets("A")
For Each r In ws.AutoFilter.Range.EntireRow
    If r.Hidden Then d.Add r.Address, 0
Next
If d.Count > 0 Then ws.Range(Join(d.Keys, ",")).Delete

Comments

[riko]

ご回答ありがとうございます！
反応遅くなり申し訳ありません。
Dictionary　使用したことがなかったので勉強になりました！
ありがとうございます。

Answer 2

動かしてみたところ、AFN の値があやしいような。
それと Delete したら行が繰り上がるから下から消すべきところでは。
★の４行を変えてみました。これでいかがでしょう？

Dim AD1 As Date
Dim AD2 As Date

AD1 = TextBox3.Value
AD2 = TextBox4.Value

Worksheets("データ移行").Select

 Dim AFN As Long  '-----------★
 AFN = Worksheets("データ移行").Cells(Rows.Count, 1).End(xlUp).Row  '-----------★

Worksheets("データ移行").Range("A2").AutoFilter field:=1, Criteria1:=">=" & AD1, Operator:=xlAnd, Criteria2:="<=" & AD2


'抽出した結果をAシートに移行

 Sheets("データ移行").Copy AFTER:=Worksheets("B")
 ActiveSheet.name = "A"

'オートフィルターを解除
 Worksheets("データ移行").Select
 Worksheets("データ移行").Range("A2").Select
 Selection.AutoFilter


'オートフィルタで非表示になっている行を削除
 Worksheets("A").Select
 Dim iAA As Long


 For iAA = AFN To 2 STEP -1  '-----------★
    If Worksheets("A").Rows(iAA).Hidden Then Worksheets("A").Rows(iAA).Delete

 Next iAA

  Worksheets("A").AutoFilterMode = False  '-----------★

Comments

[riko]

反応遅くなりすみません
添削ありがとうございます！
上手くいきました！！
助かりました！！