Excel VBA自动公式更新V2：修改后代码失效求助

此前可正常运行的代码：

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    
    Const FIRST_CELL_ADDRESS As String = "A2"
    Dim FeuilleExclue() As Variant: FeuilleExclue = _
        Array("HISTO", "VUE FINALE ANALYTIQUE", "BFT RENDEMENT 2030 CLIMAT")
    
    If IsNumeric(Application.Match(sh.Name, FeuilleExclue, 0)) Then Exit Sub
    
    Dim trg As Range:
    With sh.Range(FIRST_CELL_ADDRESS)
        Set trg = .Resize(sh.Rows.Count - .Row + 1)
    End With
    
    Dim irg As Range: Set irg = Intersect(trg, Target)
    If irg Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    ' This simplification is possible because you cannot paste a non-contiguous
    ' range unless you use VBA, and when you don't plan on clearing values.
    ' If you plan clearing values, loop trough the cells of `irg`,
    ' e.g., 'For Each cell In irg.Cells: With cell.EntireRow',
    ' and add an `If` statement in-between leaving the rest as is.
    With irg.EntireRow
        .Columns("H").FormulaR1C1 = "=IF(RC5<>"""",RC5/RC3 - 1,"""")"
        .Columns("I").FormulaR1C1 = _
            "=IFERROR(IF(AND(RC8<>"""",RC13<>""""),RC8-RC13,""""),"""")"
        .Columns("J").FormulaR1C1 = "=IF(RC9<>"""",ABS(RC9),"""")"
        .Columns("K").FormulaR1C1 = "=IF(R[+1]C7<>"""",R[+1]C7,"""")"
        .Columns("L").FormulaR1C1 = "=IF(R[+1]C7<>"""",RC11-RC7,"""")"
        .Columns("M").FormulaR1C1 = _
            "=IF(RC11<>"""",VLOOKUP(RC11,C15:C17,3,FALSE),"""")"
    End With
     
    Application.EnableEvents = True

End Sub

尝试新增P列触发公式更新功能后，代码完全失效（原A列功能也无法运行），修改后的代码：

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    
    Const FIRST_CELL_ADDRESS_A As String = "A4"
    Const FIRST_CELL_ADDRESS_P As String = "P4"
    Dim FeuilleExclue() As Variant: FeuilleExclue = _
        Array("HISTO", "VUE FINALE ANALYTIQUE", "BFT RENDEMENT 2030 CLIMAT")
    
    If IsNumeric(Application.Match(sh.Name, FeuilleExclue, 0)) Then Exit Sub
    
    Dim trgA As Range:
    With sh.Range(FIRST_CELL_ADDRESS_A)
        Set trgA = .Resize(sh.Rows.Count - .Row + 1)
    End With
    
    Dim trgP As Range:
    With sh.Range(FIRST_CELL_ADDRESS_P)
        Set trgP = .Resize(sh.Rows.Count - .Row + 1)
    End With
    
    Dim irgA As Range: Set irgA = Intersect(trgA, Target)
    Dim irgP As Range: Set irgP = Intersect(trgP, Target)
    
    If irgA And irgP Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    ' This simplification is possible because you cannot paste a non-contiguous
    ' range unless you use VBA, and when you don't plan on clearing values.
    ' If you plan clearing values, loop trough the cells of `irg`,
    ' e.g., 'For Each cell In irg.Cells: With cell.EntireRow',
    ' and add an `If` statement in-between leaving the rest as is.
    If Not irgA Is Nothing Then
        With irgA.EntireRow
            .Columns("H").FormulaR1C1 = "=IF(RC5<>"""",RC5/RC3 - 1,"""")"
            .Columns("I").FormulaR1C1 = _
                "=IFERROR(IF(AND(RC8<>"""",RC13<>""""),RC8-RC13,""""),"""")"
            .Columns("J").FormulaR1C1 = "=IF(RC9<>"""",ABS(RC9),"""")"
            .Columns("K").FormulaR1C1 = "=IF(R[+1]C7<>"""",R[+1]C7,"""")"
            .Columns("L").FormulaR1C1 = "=IF(R[+1]C7<>"""",RC11-RC7,"""")"
            .Columns("M").FormulaR1C1 = _
                "=IF(RC11<>"""",VLOOKUP(RC11,C15:C17,3,FALSE),"""")"
        End With
    End If
    
    If Not irgP Is Nothing Then
        With irgP.EntireRow
            .Columns("Q").FormulaR1C1 = "=IF(RC16 <>"""",RC16 / R[-1]C16 -1, """")"
        End With
    End If
            
    Application.EnableEvents = True
    
End Sub

问题原因与修正方案 #

核心错误 #

修改后的代码中，判断两个Range是否都为空的语法错误：

If irgA And irgP Is Nothing Then Exit Sub

在VBA中，判断对象是否为Nothing必须使用Is Nothing，不能直接用对象名作为布尔值。这行错误语法会直接触发运行时错误，导致整个Workbook_SheetChange事件失效。

正确写法应为：

If (irgA Is Nothing) And (irgP Is Nothing) Then Exit Sub

修正后的完整代码 #

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    
    Const FIRST_CELL_ADDRESS_A As String = "A4"
    Const FIRST_CELL_ADDRESS_P As String = "P4"
    Dim FeuilleExclue() As Variant: FeuilleExclue = _
        Array("HISTO", "VUE FINALE ANALYTIQUE", "BFT RENDEMENT 2030 CLIMAT")
    
    If IsNumeric(Application.Match(sh.Name, FeuilleExclue, 0)) Then Exit Sub
    
    Dim trgA As Range:
    With sh.Range(FIRST_CELL_ADDRESS_A)
        Set trgA = .Resize(sh.Rows.Count - .Row + 1)
    End With
    
    Dim trgP As Range:
    With sh.Range(FIRST_CELL_ADDRESS_P)
        Set trgP = .Resize(sh.Rows.Count - .Row + 1)
    End With
    
    Dim irgA As Range: Set irgA = Intersect(trgA, Target)
    Dim irgP As Range: Set irgP = Intersect(trgP, Target)
    
    ' 修正判断逻辑：只有当A列和P列的触发区域都为空时才退出
    If (irgA Is Nothing) And (irgP Is Nothing) Then Exit Sub
    
    Application.EnableEvents = False
    
    If Not irgA Is Nothing Then
        With irgA.EntireRow
            .Columns("H").FormulaR1C1 = "=IF(RC5<>"""",RC5/RC3 - 1,"""")"
            .Columns("I").FormulaR1C1 = _
                "=IFERROR(IF(AND(RC8<>"""",RC13<>""""),RC8-RC13,""""),"""")"
            .Columns("J").FormulaR1C1 = "=IF(RC9<>"""",ABS(RC9),"""")"
            .Columns("K").FormulaR1C1 = "=IF(R[+1]C7<>"""",R[+1]C7,"""")"
            .Columns("L").FormulaR1C1 = "=IF(R[+1]C7<>"""",RC11-RC7,"""")"
            .Columns("M").FormulaR1C1 = _
                "=IF(RC11<>"""",VLOOKUP(RC11,C15:C17,3,FALSE),"""")"
        End With
    End If
    
    If Not irgP Is Nothing Then
        With irgP.EntireRow
            ' 优化公式：避免第4行引用上方空行出错
            .Columns("Q").FormulaR1C1 = "=IF(AND(RC16<>"""",R[-1]C16<>"""",ROW()>4),RC16/R[-1]C16-1,"""")"
        End With
    End If
            
    Application.EnableEvents = True
    
End Sub

额外优化说明 #

针对P列的公式，增加了ROW()>4的判断，避免第4行（触发起始行）向上引用第3行时出现错误，你可以根据实际表格结构调整这个判断条件。

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