TODAY（）で設定したセルの日付が変わったらマクロを実施させたい

”A3”セルに、TODAY（）を入れて、平成〇〇年XX月△△日と表示させています。
マクロは、”O9”セルの値をコピーし、”O8”セルに貼り付け、”N9"セルの値を”０”にする。
としており、下記の設定をしましたが実行されません。アドバイスをお願い致します。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A3").Value Then
Sub Macro1()
'
' Macro1 Macro
'
Range("O9").Select
Selection.Copy
Range("O8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N9").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "0"
Range("N10").Select
End Sub

No.3 回答者： ママチャリ 回答日時： 2016/09/25 21:38

該当ブックを開いたまま、翌日を迎えた時でも、自動で実行できるようにしてみました。

下記のコードを指定のモジュールの下に張り付けてみて下さい。

【ThisWorkbook】
Private Sub Workbook_Open()
Call Update_A3
End Sub

【Sheet1】
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Set myRng = Intersect(Target, Me.Range("A3"))
If myRng Is Nothing Then Exit Sub
Range("O9").Copy
Range("O8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("N9").FormulaR1C1 = "0"
End Sub

【標準モジュール】
Sub Update_A3()
Dim dt As Date
dt = DateValue(Format(Now(), "yyyy/mm/dd"))
With Sheets("Sheet1")
If DateValue(Format(.Range("A3").Value, "yyyy/mm/dd")) <> dt Then
.Range("A3").Value = dt
End If
Application.OnTime dt + 1, "Update_A3"
End With
End Sub

上記のVBAはブックを開いた時、または、日が変わった時に実行されます。
日が変わった時の動作を確認するには、そのタイミングまで待つ必要があるので結構大変です。そこで、分単位で実行されるバージョンを作ってみました。
標準モジュールの Update_A3 を次のコードに置き換えて下さい。1分毎に更新されるのが確認できます。
ちなみに、A3セルの書式を時分まで見えるようにしてから実行してくださいね。

Sub Update_A3()
Dim dt As Date
dt = DateValue(Format(Now(), "yyyy/mm/dd")) + TimeValue(Format(Now(), "hh:mm:00"))
With Sheets("Sheet1")
If DateValue(Format(.Range("A3").Value, "yyyy/mm/dd")) + _
TimeValue(Format(.Range("A3").Value, "hh:mm:00")) <> dt Then
.Range("A3").Value = dt
End If
Application.OnTime dt + TimeValue("00:01:00"), "Update_A3"
End With
End Sub

この回答へのお礼

有難う御座いました。早速試してみたいいと思います。

お礼日時：2016/09/26 08:09

No.2 回答者： hallo-2007 回答日時： 2016/09/22 18:49

＞これで良いのでしょうか？

はい、良いと思いますが、ご希望の動作になるか、確認してみて下さい。
Bookモジュールに
Private Sub Workbook_Open()
Range("A3").Value =Date
End Sub
と
シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Adrress = "A3" Then
Range("O8").Value=Range("O9").Value
Range("N9").Value = "0"
End If
End Sub
でも同じ動作になりませんでしょうか。

この回答へのお礼

有難うございます。これで試してみます、これでうまく行けば
良いんですが・・・・。

お礼日時：2016/09/23 16:11

No.1 回答者： hallo-2007 回答日時： 2016/09/22 16:12

多分に

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A3").Value Then
を関数を入れているA3セルの値が変更されたら実行　と勘違いだと

これでは、関数以外のセルに日付を入れるセルがあった
その結果が、Today関数の日付と一緒だった場合に以下を実行です。
Today関数は、引数がありませんので
Private Sub Worksheet_Change(ByVal Target As Range)
では実行されません。

ご希望の動作ですが、Today関数ですので、再計算されて結果が変わるのは
１、翌日にファイルを開いだ場合
２、ファイルを開いた状態で、パソコンの電源も切らずに翌日になり
再計算を実行した場合
位しか思いつかないのですが。
運用で２のケースはないとすれば
ファイルを開いた際にVBAを実行させては如何でしょうか
イベントの　Open　を使います。
Today関数ではなく
range("A3").Value = date
として、開いたときにA3セルに日付を入れた方が楽だと思います。

この回答へのお礼

早々に有難う御座いました。ただ、素人なものですからよく理解できません。これで良いのでしょうか？
Private Sub Workbook_Open()
Range("A3").Value =Date
Sub Macro1()
'
' Macro1 Macro
'
Range("O9").Select
Selection.Copy
Range("O8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N9").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "0"
Range("N10").Select
End Sub

お礼日時：2016/09/22 18:04