繁体   English   中英

在VBA中使用Worksheet_Change事件,带范围,如果值为空,如何返回相邻单元格的值

[英]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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM