|
> これをD列からF列の範囲で適応したいのですが
一応、D列からF列には対応させましたが、こんな感じで如何でしょうか。
ただし、ちょっと希望する仕様が、はっきりしない部分があります。
まず、Changeイベントを使用していますので、変更は、セル1個ずつとは限りません。
一応、フィルドラッグ等の同時に複数セル入力/変更にも対応させています。
D〜F列のデータは、何処か 1列 に入るだけですか?
それならいいのですが、D6、E6、F6 にデータが入っている状態で、例えば E6 を
消去すると、他が残っているのに番号と日付が消えます。
今までのコードも、そのような仕様になっていたと思いますが、そこはそのままにしています。
いずれかが、残っていれば、番号と日付を残すのでありば、そのように変更してください。
Private Sub Worksheet_Change(ByVal Target As Range)
Const START_ROW = 6 ' データ行の最初
Const NO_COLUMN = 2 ' 番号
Const DATE_COLUMN = 3 ' 日付
Dim Rng As Range
Dim TgRng As Range
Set TgRng = Intersect(Range("D" & START_ROW & ":F65536"), Target)
If TgRng Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Rng In TgRng
If Not IsEmpty(Rng.Value) Then
Cells(Rng.Row, NO_COLUMN).Value = Rng.Row - START_ROW + 1
Cells(Rng.Row, DATE_COLUMN).Value = Date
Else
Cells(Target.Row, NO_COLUMN).Value = Empty
Cells(Target.Row, DATE_COLUMN).Value = Empty
End If
Next Rng
Application.EnableEvents = True
Set TgRng = Nothing
End Sub
|
|