Excel2016のVBAでオートフィルタのループ処理の完了方法

初めて質問させて頂きます、VBA初心者です。
Excel2016でオートフィルタのループ処理が終わらずExcelがフリーズしてしまいます。

初心者なりに、こうかしらと思いつつ作成いたしましたので、お見苦しかったりそもそも間違えているかもしれません。

至らない点が多く恐縮ですが、何卒ご教授どうぞ宜しくお願い致します。

前提・実現したいこと

◆シート構成は検索、一覧、計算の3種類です。

1.　検索シートに商品名と商品IDを入力

2.　検索シートの商品ID(B列)を、一覧シートの商品ID(F列)でフィルタ（今回は2種類で、まずはB2のA123-456を検索）※検索シートに入力される品目数(行数)は変動します。

3.　オートフィル(J列)の数字をコピー

4.　商品ID(F列)のオートフィルタを解除

5.　オートフィル(J列)を3.でコピーした数字でオートフィルタ

6.　フィルタされたものをコピー

7.　計算シートに値として貼り付け

8.　以下、検索シートのB列の最終行までループ処理

発生している問題

ループ処理が終わりません

該当のソースコード

Sub テスト()

lastlow = WorkSheets("一覧").Cells(Rows.Count, 1).End(xlUP).Row

Sheets("一覧").Select
Rows("1:1").Select

If ActiveSheet.AutoFilterMode = True Then
Else
Selection.AutoFilter
End If

 商品ID = Sheets("検索").Range("B2")

i = 2
Do While i <> l + 1

    ActiveSheet.Range("$A$1:$J$").AutoFilter Field:=6, Criteria1:=商品ID
    l = Range("A1").End(xlDown).Row

    Do Until Range("A1").Offset(i, 9).EntireRow.Hidden = False

     i = i + 1

    Loop

    If Range("A1").Offset(i, 9) = "" Then
    Else

    オートフィル番号 = Range("A1").Offset(i, 9).Text

    ActiveSheet.Range("$A$1:$J$" & lastrow).AutoFilter Field:=10, Criteria1:=オートフィル番号
    ActiveSheet.Range("$A$1:$J$" & lastrow).AutoFilter Field:=6

    Range("A1").CurrentRegion.Offset(1, 0).Select
    Selection.Resize(Selection.Rows.Count - 1).Copy Sheets("計算").Range("A20000").End(xlUp).Offset(1, 0)
    ActiveSheet.Range("$A$1:$J$" & lastrow).AutoFilter Field:=10

      i = i + 1
      l = l + 1

    End If

Loop

End Sub

補足情報

Excel2016で作成しております。

行動規範の内容に同意します

回答1件

ベストアンサー

ループに該当する部分にインデントを付けてみました
無限ループを起こしているのは一番外側のループではないかと思われます
ループ条件であるi <> l + 1について、i = lの状態からi = i + 1が2回以上実行されると無限ループに入ります
また、4行目のl = Range("A1").End(xlDown).Rowによって、ループ末尾のl = l + 1がすぐに元に戻っています
一番簡単な方法は、最終行を"超えた"ときにループを抜ける方法かと思います
つまり、Do While i <= l + 1という条件にすることです

VBA
1Do While i <> l + 1
2
3  ActiveSheet.Range("$A$1:$J$").AutoFilter Field:=6, Criteria1:=商品ID
4  l = Range("A1").End(xlDown).Row
5
6  Do Until Range("A1").Offset(i, 9).EntireRow.Hidden = False
7
8    i = i + 1
9
10  Loop
11
12  If Range("A1").Offset(i, 9) = "" Then
13  Else
14
15    オートフィル番号 = Range("A1").Offset(i, 9).Text
16
17    ActiveSheet.Range("$A$1:$J$" & lastrow).AutoFilter Field:=10, Criteria1:=オートフィル番号
18    ActiveSheet.Range("$A$1:$J$" & lastrow).AutoFilter Field:=6
19
20    Range("A1").CurrentRegion.Offset(1, 0).Select
21    Selection.Resize(Selection.Rows.Count - 1).Copy Sheets("計算").Range("A20000").End(xlUp).Offset(1, 0)
22    ActiveSheet.Range("$A$1:$J$" & lastrow).AutoFilter Field:=10
23
24    i = i + 1
25    l = l + 1
26
27  End If
28
29Loop

投稿2021/04/08 06:38

編集2021/04/08 08:06

Third_Kei

総合スコア65

yukihara

2021/04/08 08:06 編集

Third_Kei様　早速のご教授を頂き、ありがとうございました。　なるほど、最終行を超えたら処理するコードにしなければならなかったのですね。　とても勉強になります！　　ですが、Do While i <> l + 1をDo While i > l + 1に変更しても無限ループから抜け出せませんでした。