Excel VBA-根据条件发送邮件，仅适用于第一个范围

时间：2018-07-31 08:42:24

标签： excel vba email conditional-statements

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

如果我更改其他内容，则不会触发。 有任何解决方法的想法吗？

其他：我想在电子邮件中受影响的单元格上方写4个单元格。 例如A4将触发条件，我要写入“ A2，A3 电子邮件中的“ B2，B3”。 有人可能会想到如何在受影响的单元上方选择4x4的区域？这是可能的还是我需要在代码中修改？！

谢谢。

btw：我知道我的代码很糟糕，但是我对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

Update2：

太好了，现在可以使用以下代码：

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

1 个答案:

答案 0 :(得分：1)

您的代码几乎没有问题：

  1. If rg1 Is Nothing Then Exit Sub：这表示如果Target和Range("A4", "H4")之间没有交集，则该子项应退出。我想你的意思是，只有在有一个相交的情况下，才应评估以下条件：

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

  2. VBA中有short circuit evaluation个逻辑运算符。这意味着当您编写If x And y Then时，x和y都将被评估。在您的情况下，这意味着即使IsNumeric(Target.Value)为假，也会对Target.Value < 21进行评估。如果Target.Value是某个字符串，则会引发错误。

  3. [已添加]如果已经找到其他路口，则无需评估。您应该退出子目录：

    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

  4. [添加2]您不能假设Target中的Worksheet_Change始终是一个单元格范围。例如。如果我复制一个值，选择多个单元格并粘贴该值，则我将一次更改多个单元格的值，Target的{​​{1}}将由所有单元格组成。根据您要执行的操作，您可能只想评估范围中的第一个单元格，或者遍历所有单元格：

    Worksheet_Change

    作为旁注：

    • 通常尽量避免使用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 并进行适当的错误处理
      • 您的代码中的
    • [已编辑！]，无需声明那么多范围。如果将ifs编写为On Error Resume Next
      • ，则该代码可能更具可读性
相关问题
最新问题