在VBA excel中合并两个工作表更改事件

我无法将两个事件合并为一个

当同一行上的“A”更改值时，第一个代码将包含“黑色”和“白色”的所有单元格更改为“灰色”

代码1:

Private Sub Worksheet_Change(ByVal Target As Range)


Application.ScreenUpdating = False
    
Dim oRng As Range
Dim oCell As Range

If Intersect(Target, Target.Parent.Range("A:A")) Is Nothing Then Exit Sub

    Set oRng = Target.Parent.Range("B" & Target.Row & ":" & Target.Parent.Cells(Target.Row, Target.Parent.UsedRange.Columns.Count).Address)

        For Each oCell In oRng
            If oCell.Value = "Black" Then
            oCell.Value = "Grey"
        End If
    Next

       For Each oCell In oRng
            If oCell.Value = "White" Then
            oCell.Value = "Grey"
        End If
    Next

        
Application.ScreenUpdating = True
    

End Sub

当该列上的“黑/白”更改为“灰”时，第二个代码调用某个mailmacro

代码2：

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Application.ScreenUpdating = False
    
        If Intersect(Range("B:B"), Target) Is Nothing Then
    
             If Target.Value = "Grey" Then
        
                Call Mail1
            
            End If
            
    ElseIf Intersect(Range("C:C"), Target) Is Nothing Then
    
             If Target.Value = "Grey" Then
        
                Call Mail2
             
            End If
            
        End If

    Application.ScreenUpdating = True

End Sub

这两个代码都是独立工作的，但是在尝试合并它们时，我无法让宏调用工作，但是我也没有收到某种错误消息。它只是不调用宏

例如：

Private Sub Worksheet_Change(ByVal Target As Range)


Application.ScreenUpdating = False
    
Dim oRng As Range
Dim oCell As Range

If Intersect(Target, Target.Parent.Range("A:A")) Is Nothing Then Exit Sub

    Set oRng = Target.Parent.Range("B" & Target.Row & ":" & Target.Parent.Cells(Target.Row, Target.Parent.UsedRange.Columns.Count).Address)

        For Each oCell In oRng
            If oCell.Value = "White" Then
            oCell.Value = "Grey"
        End If
    Next

        For Each oCell In oRng
            If oCell.Value = "Black" Then
            oCell.Value = "Grey"
        End If
    Next


If Intersect(Range("B:B"), Target) Is Nothing Then
    
    If Target.Value = "Grey" Then
        
        Call Mail1
            
    End If
            
ElseIf Intersect(Range("C:C"), Target) Is Nothing Then
    
    If Target.Value = "Grey" Then
        
        Call Mail2
             
    End If
        
End If
        
Application.ScreenUpdating = True
    
End Sub

---

有什么建议吗？谢谢大家

我重构了下面的代码。这应该行得通。比本的评论是正确的

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
    
Dim oRng As Range
Dim oCell As Range

If Not Intersect(Target, Target.Parent.Range("A:A")) Is Nothing 

    Set oRng = Target.Parent.Range("B" & Target.Row & ":" & Target.Parent.Cells(Target.Row, Target.Parent.UsedRange.Columns.Count).Address)

        For Each oCell In oRng
            If oCell.Value = "White" or oCell.Value = "Black" Then
                oCell.Value = "Grey"
            End If
        End If
    Next

End If

If Not Intersect(Range("B:B"), Target) Is Nothing Then
    
    If Target.Value = "Grey" Then
        
        Call Mail1
            
    End If
            
ElseIf Not Intersect(Range("C:C"), Target) Is Nothing Then
    
    If Target.Value = "Grey" Then
        
        Call Mail2
             
    End If
        
End If
        
Application.ScreenUpdating = True
    
End Sub

---

如果Intersect（Target，Target.Parent.Range（“A:A”））为空，则退出Sub

-如果不满足第一个条件，则退出。。。这很可能会阻止您进入下一个条件（B列）。

Target.Parent

也可以简化为

Me

。效果很好。即时帮助。非常感谢！