Excel　VBAでのIntersect

前提・実現したいこと

Excel VBA初学者です。
編集シートのChangeイベントで、特定の列（I列）でセルの編集（コピペや複数セルにまたがった編集含む）があった場合、別シートに作成済みのマスタシートから対応ケースを自動判断して「編集実行orアラートメッセージ表示」を行うマクロを作成したいです。

■シート記載情報
編集シートのユニークID（B列）、セレクトID（I列）を元に
マスタシートのユニークID（B列）、セレクトID（C列）を作成。
マスタシートに対応方法のキー（D列）記載

■マクロの実行内容
編集シートのセレクトID（I列）編集をトリガーに、マスタキーから対応方法チェック。
マスタシートキー（D列）は「0,1,2」の以下3ケース
0：アラートmsg出し、OKの場合は編集実行・D列を2に書き換え。キャンセルは編集値を元に戻して中止
1：編集実行OK
2：編集実行OK

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

エラーは出ていません。下記のコードを入れるとトリガーの編集を行って、マスタキー0となるケースでもアラートmsgが出ません。
該当箇所を削除するとうまく実行できることから問題個所は明らかにここだと思うのですが、何が問題か分からず。。代替の方法も思いつかず。。

   If xRngs Is Nothing Then
        Exit Sub

↑この2行（+該当するEnd If）を削除すると想定通り、アラートmsgは出るのですが、そうすると次は下記の問題が起きてしまい消すことができません。。なので、この箇所を解決して、Changeイベントが問題なく動いてくれるといいのですが。。

他のマクロを標準モジュールから実行すると、下記の箇所（問題個所のすぐ下）にエラーが出ます。（↑コードを削除するとエラーは出ません）

オブジェクトが必要です

For Each xRng In xRngs

該当のソースコード

VBA
1Private Sub Worksheet_Change(ByVal Target As Range)
2
3Application.ScreenUpdating = False
4
5With Worksheets("編集シート")
6
7Dim xRngs As Range, xRng As Range
8Dim numID As Long, numSelect As Variant
9Dim SerchRange As Range, result As Long
10Dim judge As Long, rngJud As Range
11
12Set xRngs = Intersect(Target, Range("I:I"))  'xRngs：編集されたセレクトIDの範囲
13Set SerchRange = Worksheets("マスタ").Range("B3:D100001")  'SerchRange：マスタ
14
15'''問題の箇所'''
16
17   If xRngs Is Nothing Then
18        Exit Sub
19'''''''''''''''
20        For Each xRng In xRngs
21            numID = xRng.Offset(0, -7).Value '編集シートのB列
22            
23            If numID = 0 Then 'ユニークIDなしは編集実行OK
24                Exit Sub
25            
26            Else
27                judge = WorksheetFunction.VLookup(numID, SerchRange, 3, False) 'マスタのキー項目
28                    
29                If judge = 0 Then
30                    result = MsgBox("初期値から変更しますか？", vbOKCancel)
31                    numSelect = WorksheetFunction.VLookup(numID, SerchRange, 2, False) 'マスタ記載のセレクトID
32                        
33                    If result = vbCancel Then 'キャンセルの場合は編集中止。元の値に戻して終了
34                        Application.EnableEvents = False
35                        Application.Undo
36                        Application.EnableEvents = True
37                        Exit Sub
38                        
39                    ElseIf numSelect <> xRng.Value Then
40                        Set rngJud = Worksheets("マスタ").Range("B:B").Find(numID).Offset(0, 2)
41                        rngJud.Value = 2
42                    
43                    End If
44                End If
45            End If
46        Next xRng
47    End If
48End With
49
50Application.ScreenUpdating = True
51
52End Sub

ここさえ解決できればなんとかちゃんと動きはするようになるので、、なんとかお力を貸していただき完成できればと思っています、、

拙いコードと説明かと思いますが、お気づきの点ございましたらどんなことでも結構ですので、ご指摘いただければ大変ありがたいです。
どうぞよろしくお願いいたします。

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

回答1件

ベストアンサー

下記のように修正してください。

vba
1'前略
2
3
4'''問題の箇所'''
5
6   If Not xRngs Is Nothing Then '※修正 Not を挿入
7'        Exit Sub  ※この行削除
8'''''''''''''''
9        For Each xRng In xRngs
10            numID = xRng.Offset(0, -7).Value '編集シートのB列
11
12'後略

解説

元のコードと一見同じ内容に見えるので、なぜ動くようになったのか。。

もしよろしければご教示いただけないでしょうか。

修正前

vba
1
2   If xRngs Is Nothing Then '編集されたセルがなければ、
3       Exit Sub  'End Sub まで跳ぶ = これ以降のコードは実行されない
4 
5       For Each xRng In xRngs
6           ....
7       Next xRng
8   End If
9
10   Application.ScreenUpdating = True
11
12End Sub

つまり、
I列で編集がなければ、End Sub まで跳んでしまいApplication.ScreenUpdating = Trueが実行されないのでApplication.ScreenUpdatingはFalseのままで画面が更新されない。
I列で編集があれば、End If まで跳ぶので、End If の前の処理(For Each ... Next)は実行されない。
結局、どちらにしてもFor Each ... Next の処理は実行されない。

修正後

vba
1   If Not xRngs Is Nothing Then '※編集セルがNothingでない=編集セルが存在すれば、以下実行
2
3       For Each xRng In xRngs
4           ....
5       Next xRng
6   End If
7
8   Application.ScreenUpdating = True
9
10End Sub