[英]How to change cell value using Worksheet_change event without triggering a second call
[英]Using Worksheet_Change event in VBA, with a range, how to return value of adjacent cell if value is nothing
如果当前单元格值在提供的范围内,我正在尝试利用 VBA 中的 Worksheet_Change 事件返回相邻单元格的值。 即如果当前单元格 F3 为空,则返回单元格 G3 中的内容。 此公式仅适用于 F3 到 F37 范围内的单元格。 这是我当前的代码,当范围内的任何单元格为空时,代码似乎不会评估(即从相邻单元格复制数据),并保持为空。 任何帮助将不胜感激。 谢谢!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Set myCell = Range("F3:F37")
If Not Application.Intersect(myCell, Range(Target.Address)) Is Nothing Then
Target.Value = Cell.Offset(0, 1).Value
End If
End Sub
修改为:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Application.DisplayAlerts = False
Application.EnableEvents = False
Set myCell = Range("F3:F37")
If Not Application.Intersect(myCell, Range(Target.Address)) Is Nothing Then
If Target.Value = "" Then
Target.Value = Target.Offset(0, 1).Value
End If
End If
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
如果在事件中使用Application.EnableEvents = False
,请确保使用正确的错误处理并在事件中出现任何错误时再次启用事件( VBA 错误处理 - 完整指南)。 否则,您的事件将在出现错误时保持关闭状态,直到您完全关闭 Excel 应用程序。
请注意, Application.EnableEvents
会影响整个应用程序,这意味着在该应用程序实例中打开的所有Excel 文件。 因此,这里没有适当的错误处理可能会对其他项目产生比您想象的更大的影响。
您陷入的另一个陷阱是Target
可以是一个Range
(不仅仅是单个单元格)。 因此,例如,如果您复制/粘贴影响F3:F37
多个单元格的范围,则您的Target
不是单个单元格,因此Target.Value = ""
不起作用。 您需要遍历所有受影响的单元格:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CheckRange As Range
Set CheckRange = Me.Range("F3:F37") 'Make sure you use "Me" to refer to the same worksheet as Target (and the change event is in)
Dim AffectedCells As Range 'get the cells of CheckRange that were changed
Set AffectedCells = Application.Intersect(CheckRange, Target)
Application.EnableEvents = False
On Error GoTo ENABLE_EVENTS 'make sure you never end up in a condition where events stay disabled
If Not AffectedCells Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedCells 'loop throug all the affected cells
If Cell.Value = "" Then
Cell.Value = Cell.Offset(0, 1).Value
End If
Next Cell
End If
'no exit sub here!
ENABLE_EVENTS:
Application.EnableEvents = True
If Err.Number <> 0 Then 'make sure to re-raise an error message if there was an error (otherwise you won't ever notice that there was one), because the `On Error GoTo` statement muted the error message.
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
'above line to raise the original error message
'or at least show a message box:
'MsgBox "There was an error. Tell your Developer to fix it.", vbCritical
End If
End Sub
请注意,我删除了Application.DisplayAlerts
因为代码中没有显示任何警报的内容,因此我认为没有必要在这种情况下在这里使用它。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.