Changeイベントでの複数セルのクリアの処理について

いつもお世話になっております。

下記のVBAのプログラムは私が書籍を参考に【I列】にデータが
入力された際、【L列】に日付を反映させるプログラムになりますが、
こちらに複数セルデリートの処理を加えたく質問させていただきました。

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 9 'I列の入力時、L列に日付を入力
If Target.count > 1 Then Exit Sub
If Target.Value = "" Then '(複数セル選択時のエラー対策)
Cells(Target.Row, 12) = ""　 'I列のデータをクリアするとL列もクリア
Else
Cells(Target.Row, 12) = Format(Now(), "YYYY/MM/DD")
End If
End Select
End Sub

Cells(Target.Row, 12) = ""
こちらの構文ではＩ列のデータを消した際、L列のデータも消えるのですが
処理が1セルずつのため複数セルを一度にデリートなどの構築は可能なのでしょうか？

色々お調べしたところTargetの指定に対し複数セルが選ばれた際にエラーとなる為、
セルが1以上だった場合に処理を止める　If Target.count > 1 Then Exit Sub
こちらの構文が複数セルをデリートしても消せない原因だと思うのですが
私の知識不足によりこれ以上のことが分からず困っている次第です。

ご教示いただけると幸いです。
よろしくお願いいたします。

No.4 ベストアンサー 回答者： Qchan1962 回答日時： 2021/02/20 08:35

おはようございます

申し訳ないです。；；
色々な選択の仕方を考えすぎました。。

こちらでどうでしょう。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each c In Selection
　 Select Case c.Column
　 Case 9
'I列の入力時、L列に日付を入力
　　 If Target(1).Value = "" Then '(複数セル選択時のエラー対策)
　　　 Cells(c.Row, 12) = "" 'I列のデータをクリアするとL列もクリア
　　 Else
　　　 If Target.Column = 9 And Target.Value <> "" Then
　　　　Cells(Target.Row, 12) = Format(Now(), "YYYY/MM/DD")
　　　　GoTo EndLabel
　　　 End If
　　 End If
　 End Select
Next
EndLabel:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

この回答へのお礼

Qchan1962さんが作成していただいたこちらの
VBAで理想の処理が叶い活用させていただきます。
この度はありがとうございました。

今後も何かとこちらにお世話になるかと存じますが、
その際は何卒よろしくお願いいいたします。

お礼日時：2021/02/20 23:26

No.3 回答者： Qchan1962 回答日時： 2021/02/20 01:21

＃１，２です。

連続投稿申し訳ありません。
自身で書いたものが気に食わなく、サンプルを再提示いたします。
原型を大分変えてしまいました。
入力時、削除時共に単セルまたは、複数セルを選択した場合を想定しています。
参考程度に
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each c In Selection
Select Case c.Column
Case 9
'I列の入力時、L列に日付を入力
If Target(1).Value = "" Then '(複数セル選択時のエラー対策)
Cells(c.Row, 12) = "" 'I列のデータをクリアするとL列もクリア
Else
If c.Value <> "" Then
Cells(Target.Row, 12) = Format(Now(), "YYYY/MM/DD")
GoTo EndLabel
End If
End If
End Select
Next
EndLabel:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

ステップ実行（デバッグ）により途中で終了した場合、
Application.EnableEvents = Trueが実行されず、イベントが実行されなくなります。
念のため下記を実行すれば、シートイベントを復旧出来ます。
Sub a()
Application.EnableEvents = True
End Sub

この回答へのお礼

Qchan1962さん回答ありがとうございます。

サンプルを構築してくださりありがとうございます。

早速ですがこちらのプログラムを使わせていただいたところ、
I列にデータを入力した際のL列の挙動について質問がございます。

I列に値を入力した際にはL列の日付はまだ反映はされず、
もう一度I列に戻り値を入力した際ここでL列に入力が
行われるのですが、こちらは何か私の設定が間違っているのでしょうか？

度々の質問となり申し訳ございませんが、よろしくお願いいたします。

お礼日時：2021/02/20 07:35

No.2 回答者： Qchan1962 回答日時： 2021/02/20 00:46

＃１です

ごめんなさい。サンプルには、バグがあります。
下記の様に修正してください。

バグ
If Target.Count > 1 Then Exit Sub　'入力時

修正
If Target.Count > 1 Then GoTo EndLabel

追加
End Select　の下

EndLabel:

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

No.1 回答者： Qchan1962 回答日時： 2021/02/20 00:33

こんばんは、

If Target.count > 1 Then Exit Sub　は確かにトリガーセルが1つでないと実行から抜けるものだと思いますが、Targetが1つであっても処理範囲は1つとは限りませんね。繰り返し処理や.Reziseで範囲を広げる事が可能です。

あと、ご質問と少し違う部分ではありますが、
Worksheet_Changeでは
Application.EnableEvents = Falseを実行して
処理を行い、処理を終了したら
Application.EnableEvents = True
するようにした方が良いでしょう。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Select Case Target.Column
Case 9　　　 'I列の入力時、L列に日付を入力
　 If Target(1).Value = "" Then '(複数セル選択時のエラー対策)
　　 If Target.Count >= 1 Then
　　　 For i = 0 To Selection.Count - 1
　　　　If Selection(i + 1).Column = 9 Then　'横方向選択時の対処
　　　　 Cells(Target.Row + i, 12) = "" 'I列のデータをクリアするとL列もクリア
　　　　End If
　　　 Next
　　 End If
　 Else
　　 If Target.Count > 1 Then Exit Sub　'入力時
　　 Cells(Target.Row, 12) = Format(Now(), "YYYY/MM/DD")
　 End If
End Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

少し分かり難いところもあると思いますが、
調べながら作成したのであれば、サンプルを辿りながら調べれば
分かると思います。