セル内の日付を自動的に別のセルのテキストに基づいて追加する

Question

別のセルが「閉じた」場合にのみ、セルに日付を追加する必要があります。それに何か他のものがあるなら、私はそれを明確にする必要があります。

私は、「開く」という2つのオプションしかないドロップダウンを使用しています&「閉鎖」。 「閉鎖」を選択すると、右側のセルに現在の日付を挿入します。

セルにどのコードが入っていても日付を追加できるVBAコードがいくつか見つかりましたが、わかりません。

私は次の作品も見つけましたが、それを1列下のすべてのセルに配置する必要があります。

=IF(AND(F2<>"",F2<>"Open"),TODAY(),"") 

これは、ここでは、セルに

Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
Dim xRg As Range, xCell As Range 
On Error Resume Next 
If (Target.Count = 1) Then 
    If (Not Application.Intersect(Target, Me.Range("B:B")) Is Nothing) Then _ 
     Target.Offset(0, 1) = Date 
    Application.EnableEvents = False 
    Set xRg = Application.Intersect(Target.Dependents, Me.Range("B:B")) 
    If (Not xRg Is Nothing) Then 
     For Each xCell In xRg 
      xCell.Offset(0, -1) = Date 
     Next 
    End If 
    Application.EnableEvents = True 
End If 
End Sub 

Answer 1

何であったかのデータに関係なく、日付を追加しないだろうどのようなコードでは、恒久的に日付を入れますかなり定型Worksheet_Changeです。

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Range("F:F")) Is Nothing Then 
     On Error GoTo bm_Safe_Exit 
     Application.EnableEvents = False 
     Dim rw As Long, rng As Range 
     For Each rng In Intersect(Target, Range("F:F")) 
      Select Case LCase(rng.Value2) 
       Case "closed" 
        rng.Offset(0, 1) = Date 
        'optional date formatting 
        'rng.Offset(0, 1).numberformat = "dd-mmm-yyyy" 
       Case Else 
        rng.Offset(0, 1).ClearContents 
      End Select 
     Next rng 
    End If 

bm_Safe_Exit: 
    If CBool(Val(Err.Number)) Then _ 
     Debug.Print Err.Number & ": " & Err.Description 
    Application.EnableEvents = True 

End Sub 

これは、ワークシートのコードシート、ない標準モジュールに属します。それは、複数の削除、編集および/または追加に耐えなければならない。