Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8202 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【34615】範囲指定で質問させてください T 06/2/8(水) 11:17 質問[未読]
【34639】Re:範囲指定で質問させてください awu 06/2/8(水) 19:19 回答[未読]
【34615】範囲指定で質問させてください
質問  T  - 06/2/8(水) 11:17 -
引用なし
パスワード
   Tといいます
教えてほしいことがあるのですが
宜しくお願い致します

Const START_ROW = 6　　 ' データ行の最初
Const NO_COLUMN = 2　　 ' 番号
Const DATE_COLUMN = 3　 ' 日付


Private Sub Worksheet_Change(ByVal Target As Range)
　　
　　If Target.Row >= START_ROW _
　　　　And Target.Column <> NO_COLUMN And Target.Column <> DATE_COLUMN Then
　　　　If Cells(Target.Row, Target.Column) <> Empty Then
　　　　　　Cells(Target.Row, NO_COLUMN).Value = Target.Row - START_ROW + 1
　　　　　　Cells(Target.Row, DATE_COLUMN).Value = Date
　　　　Else
　　　　　　Cells(Target.Row, NO_COLUMN).Value = Empty
　　　　　　Cells(Target.Row, DATE_COLUMN).Value = Empty
　　　　End If
　　End If
　　' イベントを再開
'　　Application.EnableEvents = True
End Sub

上記を作成し、セルに文字入力すると日付と通し番号が入り、
文字を削除すると消えるようにしたのですが、
これをD列からF列の範囲で適応したいのですが
どう指定したらよいかわかりません。
教えて下さい。宜しくお願い致します
【34639】Re:範囲指定で質問させてください
回答  awu  - 06/2/8(水) 19:19 -
引用なし
パスワード
   > これをD列からF列の範囲で適応したいのですが

一応、D列からF列には対応させましたが、こんな感じで如何でしょうか。

ただし、ちょっと希望する仕様が、はっきりしない部分があります。

まず、Changeイベントを使用していますので、変更は、セル１個ずつとは限りません。
一応、フィルドラッグ等の同時に複数セル入力/変更にも対応させています。

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
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8202 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free