[[20090514110127]]　『日付を変わらない様にしたいのでが』（たくみ）　ページの最後に飛ぶ

『日付を変わらない様にしたいのでが』（たくみ）

予定表を作成しています。

A1に日付が入ったら、

B1に本日の日付を表示させたいのですが、

一度入った日付は変わらないようにしたいのですが、

B1　=TODAY()　だと、変更したいとき、

日付が変わってしまいます。

よろしくアドバイスをお願いします。

 マクロで制御する案です。
下記コードをシートモジュールにコピペしてください。
シートモジュールは、目的のシートのシートタブを右クリックして、コードの表示を選択すると現れます。
(ROUGE)
　
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Not Intersect(Target, Range("A:A")) Is Nothing Then
    For Each rng In Intersect(Target, Range("A:A"))
        If IsDate(rng.Value) Then
            Application.EnableEvents = False
            rng.Offset(, 1).Value = Date
            Application.EnableEvents = True
        End If
    Next
End If
End Sub

ROUGEさん、回答ありがとうございました。

勉強させてください。

A1に日付を入力するコ－ドは、
どこになるのでしょうか?

そして

B1の日付が表示されるコ－ドは、
どこになるのでしょうか?

(たくみ）

 > A1に日付を入力するコ－ドは、どこになるのでしょうか? 
 ありません。
 手入力すると思ったので。

 > B1の日付が表示されるコ－ドは、どこになるのでしょうか? 
            rng.Offset(, 1).Value = Date
 この部分です。
 A列に日付を入力したタイミングで実行されます。

 (ROUGE)

ROUGEさん、再度の回答
ありがとうございます。

 >手入力すると思ったので。
  はい手入力です。

 > rng.Offset(, 1).Value = Date
   了解しました。

ROUGEさん、今後のためにも、

もう一点、ご指導願います。

各セルの位置が違う場合は?

例えば、

A8に日付を入力

B5に表示

お願いします。

(たくみ）

 おっと、対応するセルが隣にあるものだと思い込んでコードを組んでいました。
 例えばはほかにもあるのでしょうか？
 とりあえず、A1⇒B1、A8⇒B5　に対応してみました。
　
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, ary1, ary2
ary1 = Array("A1", "A8")
ary2 = Array("B1", "B5")
If Not Intersect(Target, Range("A1,A8")) Is Nothing Then
    For Each rng In Intersect(Target, Range("A1,A8"))
        If IsDate(rng.Value) Then
            Application.EnableEvents = False
            Range(Application.Index(ary2, _
                Application.Match(rng.Address(0, 0), ary1, 0))).Value = Date
            Application.EnableEvents = True
        End If
    Next
End If
End Sub
　
(ROUGE)

ROUGEさん、返事遅れて

申し訳ありません。

 >とりあえず、A1⇒B1、A8⇒B5　に対応してみました。

ROUGEさん、できました。

更に、A1⇒B1、A8⇒B5、A10⇒B7にも対応してみました。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, ary1, ary2
ary1 = Array("A1", "A8", "A10")
ary2 = Array("B1", "B5", "B7")
If Not Intersect(Target, Range("A1,A8,A10")) Is Nothing Then

    For Each rng In Intersect(Target, Range("A1,A8,A10"))
        If IsDate(rng.Value) Then
            Application.EnableEvents = False
            Range(Application.Index(ary2, _
                Application.Match(rng.Address(0, 0), ary1, 0))).Value = Date
            Application.EnableEvents = True
        End If
    Next
End If
End Sub

完璧にできます。

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

(たくみ）

コメント返信：

[ 一覧(最新更新順) ]

[[20090514110127]] 『日付を変わらない様にしたいのでが』（たくみ） ページの最後に飛ぶ

[[20090514110127]]　『日付を変わらない様にしたいのでが』（たくみ）　ページの最後に飛ぶ