エクセル　VBA　の質問です。

解決済

質問者：shinshinranran
質問日時：2011/04/15 18:01
回答数：4件

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

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

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (4件)

ベストアンサー優先
最新から表示
回答順に表示

No.3ベストアンサー

回答者： imogasi
回答日時：2011/04/15 21:13

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
で良いようだ。

- 0
- 件

通報する

この回答へのお礼

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

通報する

お礼日時：2011/04/20 10:48

No.4

回答者： imogasi
回答日時：2011/04/15 21:50

#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
で良いのではないかと思いました。これで結果が、都合悪いですか。