エクセル VBA の質問です。

質問

A2～A20までのセルに文字を入力した段階で、それぞれB2～B20に入力日時を入れるVBAを以下のように組んでいます。

しかし、同様の条件を同一シートのE2～E20・F2～F20にも入力・自動表示できるようにしなければならなくなり、困っています。

どのように記述を変えればよいのか、教えていただけたらと思います。

宜しく御願いいたします。

Sub Worksheet_change(ByVal Target As Range)
Dim Rng As Range
Dim c As Range

Set Rng = Range("A2:A20")

If Intersect(Target,Rng) Is Nothing Then Exit Sub

For Each c In Intersect(Target,Rng)
If Not IsEmpty(c) Then
c.Offset(, 1).Value = Now
Else
c.Offset(, 1).ClearContents
End If
Next
Rng.Offset(, 1).EntireColumn.AutoFit
End Sub

申し訳ありませんが、何卒、宜しく御願いいたします。

回答No.3

imogasi · ベストアンサー

Private Sub Worksheet_change(ByVal Target As Range)
Application.EnableEvents = False
Dim Rng As Range
Dim c As Range

Set Rng = Range("A2:A20,E2:E20")

If Intersect(Target, Rng) Is Nothing Then GoTo ext

For Each c In Rng
If Not IsEmpty(c) Then
c.Offset(, 1).Value = Now
Else
c.Offset(, 1).ClearContents
End If
Next
Rng.Offset(, 1).EntireColumn.AutoFit
ext:
Application.EnableEvents = True
End Sub
---
（１）範囲拡張
Set Rng = Range("A2:A20,E2:E20")
（２）Application.EnableEvents = Falsewo
をいれた。
c.Offset(, 1).Value = Now
でＣｈａｎｇｅイベントの中にこないように
同時にIf Intersect(Target, Rng) Is Nothing Then GoTo ext
に変えてApplication.EnableEvents = True
を通るように
（３）For Each c In Intersect(Target,Rng)
を無駄を省いた。
For Each c In Rng
で良いようだ。

お礼

無事、出来上がりました。
どうもありがとうございました。

回答No.4

imogasi

#3です。
もっとコードを省いて
Private Sub Worksheet_change(ByVal Target As Range)
Application.EnableEvents = False
Dim Rng As Range
Set Rng = Range("A2:A20,E2:E20")

If Intersect(Target, Rng) Is Nothing Then GoTo ext

Target.Offset(, 1).Value = Now

Rng.Offset(, 1).EntireColumn.AutoFit
ext:
Application.EnableEvents = True
End Sub
で良いのではないかと思いました。これで結果が、都合悪いですか。

お礼

どうもありがとうございました。

回答No.2

xls88

Set Rng = Range("A2:A20")
を
Set Rng = Range("A2:A20, E2:E20")
として様子をみてください。

お礼

どうもありがとうございました。

回答No.1

keithin

変更前：
Set Rng = Range("A2:A20")

変更後：ご相談に書かれたとおり
Set Rng = Range("A2:A20,E2:E20,F2:F20")

しかし実際には，E2:E20とF2～F20では全然ダメなのは明白ですね。
倣って適切に修正し，利用して下さい。

お礼

どうもありがとうございました。