エクセル VBAで複数セル選択時エラーになる問題

お世話になります。

いろいろなところでお力を受けて、
以下のようなVBAを作ったのですが、
このような記述ですと、複数セルを選択してペーストすると
エラーが出てしまい一括処理ができなくて困っております。

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F,K:K")) Is Nothing Then
With Application
.EnableEvents = False
With Target
.Value = Application.Substitute(.Value, "A", "B")
.Value = Application.Substitute(.Value, "C", "D")
.Value = Application.Substitute(.Value, "E", "F")
.Value = Application.Substitute(.Value, "G", "H")
.Value = Application.Substitute(.Value, "H", "I")
If Target.Value = "J" Then Target.Interior.Color = vbYellow
If Target.Value = "K" Then Target.Interior.Color = 3329330
.Value = Application.Substitute(.Value, "J", "CR")
.Value = Application.Substitute(.Value, "K", "CR")
.Value = Application.Substitute(.Value, "M", "CR")
End With
.EnableEvents = True
End With
End If
End Sub

複数セルを選択して処理をするためには、
どのような記述にしたらよいでしょうか？

ご指導宜しくお願いいたします。

No.2 ベストアンサー 回答者： fujillin 回答日時： 2022/10/04 10:40

こんにちは

＞どのような記述にしたらよいでしょうか？
記述の内容が複数セルをまとめて処理できるような内容ではないので、For～Nextなどで個々のセルを処理するようにすれば良いでしょう。

例えばこんな感じ。
※ 記述法は変えましたが、処理内容はご提示のロジックのままです。
※ ですので、色に関してはセルに色を付ける処理しかしていないため、色の付いているセルの値を削除しても、色はそのままで残ります。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c, v, R, i
Set Target = Intersect(Target, Range("F:F,K:K"))
If Not Target Is Nothing Then
Application.EnableEvents = False

R = Split("A,B,C,D,E,F,G,I,H,I,J,CR,K,CR,M,CR", ",")
For Each c In Target.Cells
If c <> Empty Then
v = c.Text
If v = "J" Then c.Interior.Color = vbYellow
If v = "K" Then c.Interior.Color = 3329330
For i = 0 To 14 Step 2
v = Replace(v, R(i), R(i + 1))
Next i
c.Value = v
End If
Next c

Application.EnableEvents = True
End If
End Sub

この回答へのお礼

ご指導ありがとうございます！

まだ、作業に移れておりませんが、
勉強しながらやってみたいと思います。

お返事が遅れてしまい申し訳ございませんでした。

お礼日時：2022/10/04 22:47

No.3 回答者： Qchan1962 回答日時： 2022/10/04 16:18

こんにちは

イベントなどで使われている　Target As Range　は範囲なので複数のセル情報が入る場合があります（＃１様が回答されている通りです）

既に処理コードも示されているので参考程度の情報です
Targetは複数のセル範囲を示す場合があり、所謂Object型の変数です
Objectやコレクションなどに対して繰り返し処理をすれば1つ1つ処理する事が可能ですよね

For Each r In　・・

Next

既に単セルに対して問題がない　処理が完成されているのなら
その処理を繰り返せば良い事になります　For Eachループの中に入れる

今回はTargetの構造？なりが判れば解決できると思いました

一応、このような考え方でコードを示すと
（すべて当該モジュールに）

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F,K:K")) Is Nothing Then
Application.EnableEvents = False
Dim r As Range
For Each r In Target.Cells
Call Target_Cells(r)
Next
Application.EnableEvents = True
End If
End Sub

Private Sub Target_Cells(r As Range)
With r
.Value = Application.Substitute(.Value, "A", "B")
.Value = Application.Substitute(.Value, "C", "D")
.Value = Application.Substitute(.Value, "E", "F")
.Value = Application.Substitute(.Value, "G", "H")
.Value = Application.Substitute(.Value, "H", "I")
If .Value = "J" Then .Interior.Color = vbYellow
If .Value = "K" Then .Interior.Color = 3329330
.Value = Application.Substitute(.Value, "J", "CR")
.Value = Application.Substitute(.Value, "K", "CR")
.Value = Application.Substitute(.Value, "M", "CR")
End With
End Sub
（プロシージャに分けました。プロシージャ名は適時に）

本当は＃２様の示されているようなコードがすんなり浮かべば良いのですが

この回答へのお礼

大変勉強になりました。
ベストに選びたかったのですが、
二番の方がお早く回答して下さったので、
そちらにつけさせていただきました。

この度はありがとうございました。

お礼日時：2022/10/04 22:46

No.1 回答者： めぐみん_ 回答日時： 2022/10/04 05:52

Targetには複数セルの情報があります。

https://www.exvba.com/4016/

のようにRange型で個別に分割し１個ずつ処理を繰り返すのが必要かなと。

この回答へのお礼

大変勉強になりました。

サイトは今後の参考にいたします。

ご指導ありがとうございました。

お礼日時：2022/10/04 22:48