Vba代码今天在数据validation

我有一个电子表格单元格A2-A999中的数据validation与下拉菜单中的唯一选项是“今天”（不带引号）。 我有一个VBA代码，将单元格的值更改为今天的date，当在单元格中select“今天”。 但是，这个代码有一个问题。 当我清除一组单元格的内容时，电子表格会自动进行debugging，然后closures; 例如同时清理A1和B1。 但是，如果我单独清除A1，它将清除单元格，而不会出现任何问题。

PS通过“我清楚”，我的意思是说：“我用鼠标select一组单元格，然后点击退格button。

你们能帮我修复代码，以便我可以同时清除许多单元格，包括具有数据validation的单元格。

我正在使用的代码粘贴在工作表部分，如下所示：

Private Sub Worksheet_Change(ByVal Target As Range) selectedVal = Target.Value If Target.Column = 1 Then selectedNum = Application.VLookup(selectedVal, Worksheets("DATA- O").Range("DateToday"), 2, False) If Not IsError(selectedNum) Then Target.Value = selectedNum End If End If End Sub 

Answer 1

你的问题的答案是（正如Dirk Reichel刚刚在评论中提到的那样）循环遍历每个受影响的单元格：

 Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range If Not Intersect(Columns(1), Target) Is Nothing Then For Each c In Intersect(Columns(1), Target).Cells selectedVal = c.Value selectedNum = Application.VLookup(selectedVal, Worksheets("DATA-O").Range("DateToday"), 2, False) If Not IsError(selectedNum) Then Application.EnableEvents = False 'As recommended by K Paul c.Value = selectedNum Application.EnableEvents = True End If Next End If End Sub 

---

然而，根据你所说的代码在做什么，我不知道你为什么不只是使用：

 Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range If Not Intersect(Columns(1), Target) Is Nothing Then For Each c In Intersect(Columns(1), Target).Cells If c.Value = "Today" Then Application.EnableEvents = False 'As recommended by K Paul c.Value = Date Application.EnableEvents = True End If Next End If End Sub 

Answer 2

如果你想快，有两种方法。

使用Evaluate来做它像数组一样：

 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Columns(1), Target) Is Nothing Then With Intersect(Columns(1), Target) If Evaluate("AND(" & .Address & "<>""Today"")") Then Exit Sub .Value = Evaluate("IF(" & .Address & "=""Today"",TODAY()," & .Address & ")") End With End If End Sub 

或使用Range.Replace ，这也可以是非常快的：

 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Columns(1), Target) Is Nothing Then Intersect(Columns(1), Target).Replace "Today", Date, xlWhole, , True, , False, False End If End Sub 

一个小提示：点击 ctrl ＆ ; 会直接input今天的date