我想根据不同单元格和不同条件的条件发送电子邮件。不幸的是，我的代码只适用于第一个范围("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

您的代码有几个问题：

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
```
VBA中存在逻辑运算符短路评估。这意味着当您编写If x And y Then时，x和y都将被求值。在您的情况下，这意味着即使IsNumeric(Target.Value)为假，也将评估Target.Value < 21。如果Target.Value是某个字符串，它将引发一个错误。

[添加]如果已经找到其他交叉口，则无需对其进行评估。您应该退出sub:

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]您不能假设Worksheet_Change中的Target始终是一个单元格范围。例如，如果我复制一个值，选择多个单元格并粘贴该值，我将同时更改多个单元格的值，并且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并进行适当的错误处理
- [已编辑！]在您的代码中，不需要声明那么多范围。如果你把if写成If Not Intersect(Range("A4", "H4"), Target) Is Nothing Then，这个可能会更可读

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

更新2：

相关内容

最新更新

热门标签：