Excel中Worksheet Change Event结合单元格公式触发失效问题求助

我有一个项目问题跟踪用的Excel工作表，E列是工作包状态，包含空值、“Open”、“Initiated”、“Started”、“Done”、“Postponed”六种状态：

• E10单元格通过公式计算E11:E14分组的完成率，公式为：=COUNTIF(E11:E14,"Done")/(COUNTIF(E11:E14," ")+COUNTIF(E11:E14,"Open")+COUNTIF(E11:E14,"Initiated")+COUNTIF(E11:E14,"Started")+COUNTIF(E11:E14,"Done")+COUNTIF(E11:E14,"Postponed"))
• E15单元格通过公式计算E16:E21分组的完成率，公式为：=COUNTIF(E16:E21,"Done")/(COUNTIF(E16:E21," ")+COUNTIF(E16:E21,"Open")+COUNTIF(E16:E21,"Initiated")+COUNTIF(E16:E21,"Started")+COUNTIF(E16:E21,"Done")+COUNTIF(E16:E21,"Postponed"))

当工作包状态设为“Done”时，完成率会自动更新，但目前只有手动点击E10或E15并回车时，Worksheet Change Event才会触发后续VBA操作。需求是：只要将工作包设为“Done”（完成率自动更新）就触发对应VBA操作，无需手动回车。

当前代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)

' grouping the single work packages of Range("E11:E14")
' and calculating the percentage of execution with
' =COUNTIF(E11:E14;"Done")/(COUNTIF(E11:E14;" ")+ COUNTIF(E11:E14;"Open")+ COUNTIF(E11:E14;"Initiated")+ COUNTIF(E11:E14;"Started")+ COUNTIF(E11:E14;"Done")+ COUNTIF(E11:E14;"Postponed"))
' in cell E10
If Not Intersect(Target, Range("E10")) Is Nothing Then
'Cells - Zeile, Spalte
    Application.EnableEvents = False
    ' Here I want to code my further vba actions, which should be triggered via the change of percentage in E10 (for simplicity cell A2 get's increased by 5)
    Range("A2") = Range("A2") + 5
    Application.EnableEvents = True  
End If


' grouping the single work packages of Range("E16:E21")
' and calculating the percentage of execution with
' =COUNTIF(E16:E21;"Done")/(COUNTIF(E16:E21;" ")+ COUNTIF(E16:E21;"Open")+ COUNTIF(E16:E21;"Initiated")+ COUNTIF(E16:E21;"Started")+ COUNTIF(E16:E21;"Done")+ COUNTIF(E16:E21;"Postponed"))
' in cell E15
If Not Intersect(Target, Range("E15")) Is Nothing Then
'Cells - Zeile, Spalte
    Application.EnableEvents = False
    ' Here I want to code my further vba actions, which should be triggered via the change of percentage in E15 (for simplicity cell A3 get's increased by 6)
    Range("A3") = Range("A3") + 6
    Application.EnableEvents = True 
End If


End Sub

你的代码仅监听E10和E15的手动修改事件，但公式单元格的结果变化不会触发Worksheet_Change。正确做法是监听影响完成率的源单元格范围（E11:E14、E16:E21），当这些单元格被改为“Done”时直接触发操作。

修改后的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    
    ' 监听第一组工作包（E11:E14）
    If Not Intersect(Target, Range("E11:E14")) Is Nothing Then
        If Target.Value = "Done" Then
            Range("A2") = Range("A2") + 5 ' 替换为你的自定义操作
        End If
    End If
    
    ' 监听第二组工作包（E16:E21）
    If Not Intersect(Target, Range("E16:E21")) Is Nothing Then
        If Target.Value = "Done" Then
            Range("A3") = Range("A3") + 6 ' 替换为你的自定义操作
        End If
    End If
    
    Application.EnableEvents = True
End Sub

可选优化：避免重复触发 #

如果需要确保只有状态从非“Done”改为“Done”时才执行操作（防止重复修改同一单元格时重复触发），可添加旧值判断（需开启Excel迭代计算）：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oldValue As String
    Application.EnableEvents = False
    
    ' 获取修改前的旧值
    oldValue = Target.Value
    Target.Undo
    oldValue = Target.Value
    Target.Redo
    
    ' 第一组检查
    If Not Intersect(Target, Range("E11:E14")) Is Nothing Then
        If Target.Value = "Done" And oldValue <> "Done" Then
            Range("A2") = Range("A2") + 5
        End If
    End If
    
    ' 第二组检查
    If Not Intersect(Target, Range("E16:E21")) Is Nothing Then
        If Target.Value = "Done" And oldValue <> "Done" Then
            Range("A3") = Range("A3") + 6
        End If
    End If
    
    Application.EnableEvents = True
End Sub

开启迭代计算步骤：文件→选项→公式→勾选「启用迭代计算」。

内容的提问来源于stack exchange，提问作者tueftla