Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


47062 / 76736 ←次へ | 前へ→

【34639】Re:範囲指定で質問させてください
回答  awu  - 06/2/8(水) 19:19 -

引用なし
パスワード
   > これを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
0 hits

【34615】範囲指定で質問させてください T 06/2/8(水) 11:17 質問
【34639】Re:範囲指定で質問させてください awu 06/2/8(水) 19:19 回答

47062 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free