excelのVBAで画像の動作をさせるため、プログラムを教えてください。

添付した画像のような表を作成しています。

・B２列に名前を入力すると、その隣のC列２列には入力された日付を表示させる
・B２列の入力された名前を消すと、その隣のC列のセルの日付も消える

同じように、
・F２列に名前を入力すると、その隣のG列２列に入力された日付を表示させる
・F２列の入力された名前を消すと、その隣のG列のセルの日付も消える

この場合のプログラムを教えていただきたいです。
お忙しいところ恐縮ですがよろしくお願いいたします。

質問者からの補足コメント

• 回答いただいたみなさまありがとうございます。
  どちらもいったん使わせていただいのですが、どちらも以下の現象が起こるのですが解消できないでしょうか。
  
  ①名前を入力すると、日付が表示されず、入力したセルをクリックすると日付が表示される
  ②同じ名前を入力（ドラッグ）するとドラッグした分の日付が自動で入ってくる
  ③名前を消去すると、日付は消えないままで、消したセルをクリックすると日付が消える（①の逆みたいな現象）

    補足日時：2024/01/16 10:03

• 

  №２様
  
  返信ありがとうございます。
  excelファイルを新規にして、教えていただいたコードを入れましたが同じ現象になります・・・

    補足日時：2024/01/16 12:43

No.5 回答者： yokomaya 回答日時： 2024/01/19 17:05

最も大事なのはこういうイベント処理では、必ずコードの

最初の実行行にブレークポイントをセットして
スッテプ実行追跡するのですけど、そうしていますか？

①名前を入力すると、日付が表示されず、入力したセルをクリックすると日付が表示される
恐らくWorksheet_Changeになってないのでは？
Worksheet_SelectionChangeの場合にそうなります。

②同じ名前を入力（ドラッグ）するとドラッグした分の日付が自動で入ってくる

複数セルがある場合、個別のセルに分解して
一つ一つ処理しなければなりません。
つまりドラッグしたセルが複数あるかを確認して
処理を分岐しないといけないので、改造が必要です。
Target.Countを確認してみてください。

③名前を消去すると、日付は消えないままで、消したセルをクリックすると日付が消える
これは症状が不明です。消去するとっていうのが
見た目には消えてもEnterキーを押すもしくは
別のセルを選択しないと登録されないのは判りますか？

No.4 回答者： Qchan1962 回答日時： 2024/01/16 13:13

>excelファイルを新規にして、教えていただいたコードを入れましたが同じ現象になります・・・

残念ながら私のローカルでは事象を再現できませんでした
＃３にも書きましたが動作的にはWorksheet_SelectionChangeイベントに似ています

繰り返しになりますが Worksheet_Changeイベントで書かれていますか？

＃２のコード（イベントプロシージャ）全てをシートモジュールにコピペされているという事であれば実行環境などによるものかも知れませんが私のスキルでは想像の範疇を超えていますので新たな回答をお待ちください

No.3 回答者： Qchan1962 回答日時： 2024/01/16 10:58

#2です

・・・
事象はPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)イベントの動作のようですが・・・・・

Private Sub Worksheet_Change(ByVal Target As Range)ですよね

新規ブックで試しても同じ事象でしょうか？

No.2 回答者： Qchan1962 回答日時： 2024/01/15 20:08

複数セル、コピペに対応でベタ打ちですけれど一例です

対象のシートモジュールに（同じイベントがある場合はそのままコピペではだめです）
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B:B,F:F")) Is Nothing Then Exit Sub
If Target.Row = 1 Then Exit Sub
Dim i As Long
Application.EnableEvents = False
If Target.Count > 1 Then
For i = 1 To Target.Count
If Target(i).Column = 2 Or Target(i).Column = 6 Then
If Target(i).Value <> "" Then
Target(i).Offset(, 1).Value = Format(Date, "yyyy/mm/dd")
Else
Target(i).Offset(, 1).Value = ""
End If
End If
Next
Else
If Target.Value <> "" Then
Target.Offset(, 1).Value = Format(Date, "yyyy/mm/dd")
Else
Target.Offset(, 1).Value = ""
End If
End If
Application.EnableEvents = True
End Sub

＞プログラムを教えていただきたいです。
プログラムを考える場合もう少し条件定義をするべきだと思いますが

No.1 回答者： zongai 回答日時： 2024/01/15 19:58

名前かどうかを判断する基準が不明なので、単純にB列やF列に入力があった場合、ということにしています。

標準モジュールではなく、対象となるSheetの方にこちらのマクロを加えてください。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim changedCell As Range
　　Dim currentDate As Date

　　' Check if changes occurred in column B (2) or column F (6)
　　If Target.Column = 2 Or Target.Column = 6 Then
　　　　' Check if the changed cell is not empty
　　　　If Not IsEmpty(Target.Value) Then
　　　　　　' Get the current date
　　　　　　currentDate = Date

　　　　　　' Update column C or G with the current date
　　　　　　If Target.Column = 2 Then
　　　　　　　　Target.Offset(0, 1).Value = currentDate
　　　　　　ElseIf Target.Column = 6 Then
　　　　　　　　Target.Offset(0, 1).Value = currentDate
　　　　　　End If
　　　　Else
　　　　　　' If the changed cell is empty, clear the corresponding date cell in column C or G
　　　　　　If Target.Column = 2 Then
　　　　　　　　Target.Offset(0, 1).ClearContents
　　　　　　ElseIf Target.Column = 6 Then
　　　　　　　　Target.Offset(0, 1).ClearContents
　　　　　　End If
　　　　End If
　　End If
End Sub