【问题标题】：Excel VBA - send mail based on condition only working for first rangeExcel VBA - 根据仅适用于第一个范围的条件发送邮件
【发布时间】：2018-07-31 08:42:23
【问题描述】：

我想根据不同单元格和不同条件的条件发送电子邮件。不幸的是，我的代码仅适用于第一个范围（“A4”到“H4”）。

如果我更改其他内容，它将不会被触发。任何想法如何解决这个问题？

附加：我想在电子邮件中写下受影响单元格上方的 4 个单元格。例如A4 会触发条件我想写“A2, A3”的值 B2，B3”在电子邮件中。有人可能知道如何在受影响的单元格上方选择一个 4x4 的区域？！这是可能的还是我需要在我的代码中使用这个？！

谢谢。

顺便说一句：我知道我的代码很糟糕，但我是 VBA 的新手，所以我很高兴它能正常工作。 :D

原文代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next

    Dim rg1, rg2, rg3, rg4, rg5, rg6, rg7, rg8, rg9, rg10 As Range
    Dim rg11, rg12, rg13, rg14, rg15, rg16, rg17, rg18, rg19, rg20 As Range

  Set rg1 = Intersect(Range("A4", "H4"), Target)
    If rg1 Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value < 21 Then
        Call Mail_small_Text_Outlook
    End If
' ... similar for all ranges (with different range and condition)
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)
    If MsgBox("Senden?", vbOKCancel) = vbOK Then
         xMailBody = "test" & vbNewLine & vbNewLine & _
              "test2" & vbNewLine & _
              "test3"
        On Error Resume Next
        With xOutMail
            .To = "test@test.com"
            .CC = ""
            .BCC = ""
            .Subject = "send by cell value test"
            .Body = xMailBody
            .Display   'or use .Send
        End With
        On Error GoTo 0
        Set xOutMail = Nothing
        Set xOutApp = Nothing
        MsgBox "Mail verschickt!"
    Else
        MsgBox "Abgebrochen!"
    End If
End Sub

更新（新代码）：

我已经稍微更改了我的代码，不幸的是我现在有一个“无限”循环，发送邮件现在被触发了大约 10 次...... 可能有人能够看到为什么会发生这种情况的问题？（现在至少它会为我想要的每个单元格触发）

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next

    If Intersect(Range("A4", "H4"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("I4", "L4"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 31 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A10", "D10"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 31 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("E10", "H10"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("I10"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 51 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("K10"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A16", "F16"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 31 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("G16", "J16"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("K16"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 3 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A22", "L22"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A28", "F28"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A57"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 26 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("D57"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 16 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("G57"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A65"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("D65", "H65"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A79", "E79"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A94", "H94"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A100", "H100"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
        End If
    End If

    If Intersect(Range("A106"), Target) Then
        If IsNumeric(Target.Value) And Target.Value < 2 Then
            Call Mail_small_Text_Outlook
        End If
    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)
    If MsgBox("Senden?", vbOKCancel) = vbOK Then
         xMailBody = "test" & vbNewLine & vbNewLine & _
              "test2" & vbNewLine & _
              "test3"
        On Error Resume Next
        With xOutMail
            .To = "test@test.com"
            .CC = ""
            .BCC = ""
            .Subject = "send by cell value test"
            .Body = xMailBody
            .Display   'or use .Send
        End With
        On Error GoTo 0
        Set xOutMail = Nothing
        Set xOutApp = Nothing
        MsgBox "Mail verschickt!"
    Else
        MsgBox "Abgebrochen!"
    End If
End Sub

更新2：

太好了，它现在正在使用此代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next


    If Not Intersect(Range("A4", "H4"), Target) Is Nothgin Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("I4", "L4"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 31 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A10", "D10"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 31 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("E10", "H10"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("I10"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 51 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("K10"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A16", "F16"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 31 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("G16", "J16"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("K16"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 3 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A22", "L22"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A28", "F28"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A57"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 26 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("D57"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 16 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("G57"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A65"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("D65", "H65"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 21 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A79", "E79"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A94", "H94"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A100", "H100"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 6 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If

    If Not Intersect(Range("A106"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 2 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    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)
    If MsgBox("Senden?", vbOKCancel) = vbOK Then
         xMailBody = "test" & vbNewLine & vbNewLine & _
              "test2" & vbNewLine & _
              "test3"
        On Error Resume Next
        With xOutMail
            .To = "test@test.com"
            .CC = ""
            .BCC = ""
            .Subject = "send by cell value test"
            .Body = xMailBody
            .Display   'or use .Send
        End With
        On Error GoTo 0
        Set xOutMail = Nothing
        Set xOutApp = Nothing
        MsgBox "Mail verschickt!"
    Else
        MsgBox "Abgebrochen!"
    End If
End Sub

【问题讨论】：

标签： excel vba email conditional-statements

【解决方案1】：

您的代码存在一些问题：

If rg1 Is Nothing Then Exit Sub：这表示如果Target 和Range("A4", "H4") 之间没有交集，那么 sub 应该退出。我想你的意思是只有在有交叉点时才应该评估以下条件，所以像这样：
```
If Not rg1 Is Nothing Then
    If IsNumeric(Target.Value) And Target.Value < 21 Then
        Call Mail_small_Text_Outlook
    End If`
End If
```
VBA 中有 short circuit evaluation 的逻辑运算符。这意味着当您编写 If x And y Then 时，x 和 y 都将被评估。在您的情况下，这意味着即使 IsNumeric(Target.Value) 为假，Target.Value < 21 也会被评估。如果Target.Value 是某个字符串，则会引发错误。

[已添加] 如果已找到其他交叉点，则无需评估其他交叉点。你应该退出子：

If Not rg1 Is Nothing Then
    If IsNumeric(Target.Value) Then
        If Target.Value < 21 Then
            Call Mail_small_Text_Outlook
            Exit Sub
        End If
    End If
End If

[Added2] 你不能假设Target 中的Worksheet_Change 总是一个单元格范围。例如。如果我复制一个值，选择多个单元格并粘贴该值，我将一次更改多个单元格的值，Worksheet_Change 的Target 将由所有单元格组成。根据您想要执行的操作，您可能只想评估范围的第一个单元格或遍历所有单元格：
```
Dim cell as Excel.Range
For Each cell In Target.Cells
    If Not Not Intersect(Range("A4", "H4"), Target) Is Nothing Then
        If IsNumeric(Target.Value) Then
            If Target.Value < 21 Then
                Call Mail_small_Text_Outlook
                Exit Sub
            End If
        End If
    End If
    '...
Next
```
附注：
- 一般尽量避免On Error Resume Next 并进行适当的错误处理
- [Edited!] 在您的代码中，不需要声明那么多范围。如果您将 ifs 写为If Not Intersect(Range("A4", "H4"), Target) Is Nothing Then，则可能会更具可读性

【讨论】：

谢谢，我已经稍微修改了我的代码，但是现在有一些不同的问题，你能再看一下吗？ :)
@L.Writer 不客气，但请将旧代码放在问题中的某个地方，否则这是一个完全不同的问题，答案已过时。
@L.Writer ：对不起，第二个注释有一个错误：Intersect 返回一个 Range，而不是 Boolean，因此您需要检查它是否为 Nothing。顺便提一句。奇怪的行为是由On Error Resume Next 引起的。每次If里面的Intersect出错，就直接跳到嵌套的If里面调用mailing函数。
非常感谢。它现在正在工作（我现在使用的代码见上文）。你能告诉我如何获得单元格值 - 触发事件的单元格上方 2x2...例如，如果 A4 正在触发邮件事件，我需要“A2，A3”和“B2，B3”的值'。还是为此创建另一个线程更好？
不客气。对于周围的单元格使用Range.Offset。在 msdn 页面上有很好的例子。