vbaマクロコードでfor文を使うとメモリ不足とでてしまう。

Question

実現したいこと

for文を入れて機能させたい

前提

初心者です。
見よう見まねで連動するドロップダウンを作っていたんですが
1行分なんとか正常に機能したので
それを一般化しようとFor文を入れたところメモリ不足でうまくいきません。

発生している問題・エラーメッセージ

メモリ不足

該当のソースコード

ソースコード
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange1 As Range
Dim rngSearch1 As Range
Dim p As Long
Dim strAdr1 As String
Dim DicName2 As Variant
Dim q As Long
Dim LastRow2 As Long
Dim GetName2 As String
Dim ListName2 As String
Dim z As Long

With ActiveSheet
  For z = 2 To 9

  z = 2

    If (Target.Column = 2) And (Target.Row = z) Then

        Worksheets("1").Range("M2:M9").Value = ""

        Set myRange1 = Worksheets("1").Range("B2:B9")

        Set rngSearch1 = myRange1.Find(What:=.Cells(z, 2), LookIn:=xlValues)
        
        Application.EnableEvents = False

        If Not rngSearch1 Is Nothing Then
            p = 2

            Worksheets("1").Cells(p, 13).Value = Worksheets("1").Cells(rngSearch1.Row, 3).Value

            strAdr1 = rngSearch1.Address

            Do
                Set rngSearch1 = myRange1.FindNext(rngSearch1)
                If rngSearch1 Is Nothing Then
                    Exit Do
                Else
                     If strAdr1 <> rngSearch1.Address Then
                        p = p + 1
                        Worksheets("1").Cells(p, 13).Value = Worksheets("1").Cells(rngSearch1.Row, 3).Value

                    End If
                End If

            Loop While rngSearch1.Address <> strAdr1

        End If


        Set DicName2 = CreateObject("Scripting.Dictionary")

        LastRow2 = Worksheets("1").Cells(Rows.Count, 13).End(xlUp).Row

        For q = 2 To LastRow2

            GetName2 = Worksheets("1").Cells(q, 13).Value & ","

            If Not DicName2.Exists(GetName2) Then
                DicName2.Add GetName2, GetName2
                ListName2 = ListName2 & GetName2
            End If

        Next q

        With Cells(z, 4).Validation
            .Delete
            .Add _
            Type:=xlValidateList, _
            Formula1:=ListName2
        End With

        Set DicName2 = Nothing


        Application.EnableEvents = True

    End If

  Next z

End With

End Sub

試したこと

上記は２つ目のドロップダウンを抜粋したもので、
実際には４連動で組んでいましたが、
zの部分を定数で作っていたときは正常に動いていました。
変数zを導入したら１つ目の連動でメモリ不足になりました。
Nothingで解放を試してみましたが効果なかったようです。

補足情報（FW/ツールのバージョンなど）

動くならM列を200ぐらい
ｚを2 to 400ぐらいで機能させたいです。

Comments

[otn]

無意味な空行を取り除きましょう。非常に見にくいです。

[YellowGreen]

17行目を削除し忘れてませんか？

Answer 1

質問記載のコードの14～17行目

With ActiveSheet
  For z = 2 To 9

  z = 2

ここでFor文をセットアップした直後に、zを2に設定しています。
これだと、ループのたびにzが「2」に初期化されて、無限ループに陥ります。
結果、途中のDictionaryオブジェクトを作る部分が無限に繰り返され、メモリ不足に陥っているのだと推測されます。

対応として、「z=2」の行（17行目）を削除してみてはいかがでしょうか。