时间戳

首页 > 解决方案 > 在 Excel VBA 中为不同的目标值添加多个范围

excel - 在 Excel VBA 中为不同的目标值添加多个范围

问题描述

我试图添加 2 个不同的范围和目标值标准。如果值超出或指定目标值范围，将发送电子邮件。这是我到目前为止所拥有的：

Dim xRg As Range, rng 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(Range("K3050:K4000"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 0.534 Or Target.Value < 0.519 Then
        Call Mail_small_Text_Outlook
        End If
    
  Set rng = Intersect(Range("L3050:L4000"), Target)
    If rng Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 0.003 Or Target.Value < 0.003 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 = "There is an out of spec value on 302-0092. Please confirm."
    On Error Resume Next
    With xOutMail
        .To = "EMAIL HERE"
        .CC = ""
        .BCC = ""
        .Subject = "Out of spec value on 302-0092"
        .Body = xMailBody
        .Send   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

K3050:K4000 的第一个范围工作并且能够生成电子邮件，但我无法让第二个范围工作。

标签： excelvbaworksheet

解决方案

将评论转移到答案：

问题是If xRg Is Nothing Then Exit Sub，因为您Exit Sub在检查是否Target与第二个范围相交之前，L3050:L4000.

翻转逻辑；改变：

If xRg Is Nothing Then Exit Sub

至

If Not xRg Is Nothing Then
...
End If

同样（尽管不需要）对于rng.

推荐阅读