单元格更改时VBA发送电子邮件[重复]

问题描述 投票:0回答:3

这个问题与以下内容完全相同:

这很有效,但只有在直接更改单元格时才会删除公式。我的范围中的每个单元格都包含一个VLOOKUP公式,该公式从单独工作表中的长数据列表中获取值。这些值是从数据库导入的,并且每隔一段时间刷新一次。基本上我需要一个替代方案,当细胞通过公式改变时触发电子邮件。我希望这是有道理的。

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Intersect(Target, Range("N1:N999"))
    If xRg Is Nothing Then Exit Sub
    If (Range("N45") = Range("F45")) Then
        Call Mail_small_Text_Outlook
    End If
End Sub
Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
          xRg.Offset(0, -12) & " has reached its target"

    On Error Resume Next
    With xOutMail
        .To = "***@****.com"
        .CC = ""
        .BCC = ""
        .Subject = "Target Reached"
        .Body = xMailBody
        .Send   'or use .Display
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
excel vba excel-vba
3个回答
1
投票

我希望它有所帮助。我尽可能多地尝试代码,但是如果出现错误,你可以修改它

Private Sub Worksheet_Calculate()

Static OldVal() As Variant
Dim cll As Range

ReDim OldVal(1 To Range("N1:N999").Cells.Count)

i = 1
For Each cll In Range("N1:N999")
    If cll.Value <> OldVal(i) Then
        OldVal(i) = cll.Value
        i = i + 1
    End If
Next cll

End Sub

0
投票

你可以使用Worksheet_Calculate()事件。每次计算公式时,都会触发事件


0
投票
Private Sub Worksheet_Calculate()

Static OldVal() As Variant
Dim cll As Range

ReDim OldVal(1 To Range("N1:N999").Cells.Count)

i = 1
For Each cll In Range("N1:N999")
    If cll.Value <> OldVal(i) Then
        OldVal(i) = cll.Value
        i = i + 1
        'This part compares your new value to F column value
        'Change cll.value statement to oldval(i) to compare oldvalue and F column value
        If cll.Value = Cells(cll.Row, "F").Value Then
            'Your Code
        End If
    End If
Next cll

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.