合并两个Private Sub Worksheet_Change

我正在使用VBA来检查单元格的值，如果单元格的值大于某个值，则调用一个电子邮件模块来发送电子邮件。

我想检查多个单元格，但明白在VBA中不能有两个Private Sub Worksheet_Change。 什么是检查多个单元格的最佳方法？

这是我正在使用的代码;

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Application.Intersect(Range("A1"), Target) Is Nothing Then If IsNumeric(Target.Value) And Target.Value > 10 Then Call Mail_small_Text_Outlook End If End If End Sub 

这里是另外一个如果可能的话我想合并成一个Sub

 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Application.Intersect(Range("B1"), Target) Is Nothing Then If IsNumeric(Target.Value) And Target.Value > 20 Then Call Mail_small_Text_Outlook End If End If End Sub 

Answer 1

这样做怎么样？

 Private Sub Worksheet_Change(ByVal Target As Range) Call MailAlert(Target, "A1", 10) Call MailAlert(Target, "B1", 20) End Sub Private Sub MailAlert(ByVal Target As Range, ByVal Address As String, ByVal Value As Integer) If Target.Cells.Count > 1 Then Exit Sub If Not Application.Intersect(Range(Address), Target) Is Nothing Then If IsNumeric(Target.Value) And Target.Value > Value Then Call Mail_small_Text_Outlook End If End If End Sub 

Answer 2

 Private Sub Worksheet_Change(ByVal Target As Range) Select Case Taget.Address Case "$A$1" 'This will make sure its just one cell and its A1 If IsNumeric(Target.Value) And Target.Value > 10 Then Call Mail_small_Text_Outlook End If Case "$B$1" 'This will make sure its just one cell and its B1 If IsNumeric(Target.Value) And Target.Value > 20 Then Call Mail_small_Text_Outlook End If 'Case ... whatever else you want. End Select End Sub 

可能有更有效的方法，但是这是首先想到的。 希望这回答你的问题。