根据另一个单元格中的文本自动将单元格中的date添加到单元格中

只有在另一个单元格已经“closures”的情况下，我才需要将date添加到单元格中。 如果有其他东西，我需要清楚。

我正在使用只有两个选项“打开”和“closures”的下拉菜单。 当我select“closures”时，我希望单元格右侧插入当前date。

我发现了一些VBA代码，可以让我添加date，无论代码在单元格中，但我无法弄清楚。

我也发现了下面的工作，但是我必须把它放在每个单元格的下一列。

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

这是什么代码将添加date，无论数据在单元格中

 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，将永久地放入date。

 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 

这属于工作表的代码表， 而不是一个标准的模块。 它应该经受多次删除，编辑和/或添加。