通过公式更改单元格时,VBA代码不会运行

时间:2012-07-10 04:30:39

标签: excel vba worksheet

工作表A 包含从工作表B 收集的数据范围。 工作表A 有一个宏,用于计算数据是否高于某个值,然后调用电子邮件模块向所选用户发送电子邮件。

当在工作表A 上手动输入数据时,宏工作,但是当从工作表B 中提取数据时,它不会触发。

我不确定我的VBA代码需要更改什么。

Private Sub Worksheet_Change(ByVal Target As Range)
    Call MailAlert(Target, "B5:M5", 4) 
    Call MailAlert(Target, "B8:M8", 7) 
    Call MailAlert(Target, "B11:M11", 6)
    Call MailAlert(Target, "B14:M14", 2) 
    Call MailAlert(Target, "B17:M17", 4) 
    Call MailAlert(Target, "B20:M20", 1) 
    Call MailAlert(Target, "B23:M23", 3) 
    Call MailAlert(Target, "B26:M26", 1) 
    Call MailAlert(Target, "B29:M29", 5) 
    Call MailAlert(Target, "B32:M32", 1) 
    Call MailAlert(Target, "B35:M35", 7) 
    Call MailAlert(Target, "B38:M38", 20) 
    Call MailAlert(Target, "B41:M41", 0) 
End Sub

Private Sub MailAlert(ByVal Target As Range, ByVal Address As String, ByVal Value As Integer)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range(Address), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value > Value Then
        Call Mail_small_Text_Outlook
        End If
        Application.EnableEvents = True
    End If
End Sub

2 个答案:

答案 0 :(得分:19)

要按公式捕获更改,您必须使用Worksheet_Calculate()事件。为了理解它是如何工作的,让我们举一个例子。

  1. 创建新工作簿。
  2. 在Sheet1单元格A1中,输入此公式=Sheet2!A1+1
  3. 现在在模块中粘贴此代码

    Public PrevVal As Variant
    

    将其粘贴到“图纸代码”区域

    Private Sub Worksheet_Calculate()
        If Range("A1").Value <> PrevVal Then
            MsgBox "Value Changed"
            PrevVal = Range("A1").Value
        End If
    End Sub
    

    最后在ThisWorkbook代码区域粘贴此代码

    Private Sub Workbook_Open()
        PrevVal = Sheet1.Range("A1").Value
    End Sub
    

    关闭并保存工作簿并重新打开它。现在对Sheet2的单元格A1进行任何更改。您会注意到,您将收到消息框MsgBox "Value Changed"

    <强>快照

    enter image description here

答案 1 :(得分:0)

workheet_change事件仅在用户手动更改时触发。我认为您最好的选择是在工作表B上将其实现为工作表更改事件,我假设用户输入更改正在进行中。

如果这真的不适合你,我会建议一些替代方案,但我认为这可能是目前最好的选择。

编辑:以下评论的另一个建议

ThisWorkbook对象有一个事件SheetChange,只要工作簿中的任何工作表发生更改,就会触发该事件。如果您可以识别将在每张B纸上输入数据的范围,则可以使用原始代码中的这些范围。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Sh Is Sheets("Worksheet A") Then
        If Intersect(Sh.Range("B1:B5"), Target) Then
            'Call MailAlert as required here
        ElseIf Intersect(Sh.Range("B10:B20"), Target) Then
            'Call MailAlert as required here
        Else ' Etc...
            'Call MailAlert as required here
        End If
    End If
End Sub

让我知道这是怎么回事。