基于现有Excel VBA代码扩展功能，替代条件格式实现需求

现有代码逻辑 #

• Set1：H:K列随F:G列的变更自动更新
• Set2：N:Q列随L:M列的变更自动更新
• Set3：T:W列随R:S列的变更自动更新

新增功能需求 #

1. 各Set最后一列（K、Q、W）计算规则
   • 触发条件1：对应Set的首控制列（F/L/R）为True，或首控制列+次控制列（F&G/L&M/R&S）同时为True → 该列留空，背景填充白色
   • 触发条件2：对应Set的次控制列（G/M/S）为True → 计算对应Set首列（H/N/T）与倒数第二列（J/P/V）的和，填入该列
2. 单元格格式规则
   • 若对应Set最后一列的值≥AB1单元格值 → 文本设为绿色
   • 若对应Set最后一列的值<AB1单元格值 → 文本设为红色
   • 若A40单元格为True且对应Set首控制列（F/L/R）为True → 文本设为斜体

完整实现代码 #

保留原有代码的基础上，新增UpdateFinalColumnAndFormat过程，并在变更事件中调用：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tracker")
    
    'Build range all at once by intersecting whole columns and rows
    Dim rng As Range             'Specify columns           'Specify rows
    Set rng = Intersect(ws.Range("F:G, L:M, R:S"), ws.Range("12:29, 35:79, 86:102, 110:150"))
    
    'Identify total changed cells
    Dim rChanged As Range: Set rChanged = Intersect(Target, rng)
    
    'Prepare loop vars
    Dim rChangedCell As Range, rArea As Range
    Dim rCell1 As Range, rCell2 As Range
    
    If Not rChanged Is Nothing Then
        Application.EnableEvents = False
        
        For Each rChangedCell In rChanged.Cells
            For Each rArea In rng.Areas
                Set rCell1 = Intersect(rArea, rChangedCell)
                If Not rCell1 Is Nothing Then
                    If rCell1.Column <> rArea.Column Then Set rCell1 = ws.Cells(rCell1.Row, rArea.Column)
                    Exit For
                End If
            Next rArea
            Set rCell2 = rCell1.Offset(, 1)
            Call UpdateLine(rCell1, rCell2)
            '调用新增的格式与最后一列计算过程
            Call UpdateFinalColumnAndFormat(rCell1, ws)
        Next rChangedCell
        
        Application.EnableEvents = True
    End If

End Sub

Private Sub UpdateLine(ByVal p_rCell1 As Range, ByVal p_rCell2 As Range)

    Dim aResult As Variant
    
    Select Case (Abs(p_rCell1.Value = True) + Abs(p_rCell2.Value = True) * 2)
        '0 means both cells are False
        Case 0:     aResult = Array(False, False, vbNullString, vbNullString)
        
        '1 means p_rCell1 is True
        Case 1:     aResult = Array(True, False, Date, "No")
        
        'Otherwise p_rCell2 is True
        Case Else:  aResult = Array(False, True, Date, "Yes")
    End Select
    
    p_rCell1.Resize(, UBound(aResult) - LBound(aResult) + 1).Value = aResult

End Sub

'新增：处理最后一列计算与格式设置
Private Sub UpdateFinalColumnAndFormat(ByVal p_controlCol1 As Range, ByVal ws As Worksheet)
    Dim finalCol As Range, firstCol As Range, secondLastCol As Range
    Dim controlVal1 As Boolean, controlVal2 As Boolean
    Dim ab1Val As Variant
    
    '获取控制列的布尔值
    controlVal1 = CBool(p_controlCol1.Value)
    controlVal2 = CBool(p_controlCol1.Offset(, 1).Value)
    
    '根据控制列所在区域，匹配对应的目标列
    Select Case p_controlCol1.Column
        'Set1：F列控制 → 对应H(8), J(10), K(11)
        Case 6
            Set firstCol = ws.Cells(p_controlCol1.Row, 8)
            Set secondLastCol = ws.Cells(p_controlCol1.Row, 10)
            Set finalCol = ws.Cells(p_controlCol1.Row, 11)
        'Set2：L列控制 → 对应N(14), P(16), Q(17)
        Case 12
            Set firstCol = ws.Cells(p_controlCol1.Row, 14)
            Set secondLastCol = ws.Cells(p_controlCol1.Row, 16)
            Set finalCol = ws.Cells(p_controlCol1.Row, 17)
        'Set3：R列控制 → 对应T(20), V(22), W(23)
        Case 18
            Set firstCol = ws.Cells(p_controlCol1.Row, 20)
            Set secondLastCol = ws.Cells(p_controlCol1.Row, 22)
            Set finalCol = ws.Cells(p_controlCol1.Row, 23)
        Case Else
            Exit Sub
    End Select
    
    '获取AB1的值
    ab1Val = ws.Range("AB1").Value
    
    '处理最后一列的内容与背景色
    With finalCol
        If controlVal1 Or (controlVal1 And controlVal2) Then
            .Value = vbNullString
            .Interior.ColorIndex = xlColorIndexNone '填充白色（无填充）
        ElseIf controlVal2 Then
            '计算首列+倒数第二列的和
            .Value = firstCol.Value + secondLastCol.Value
        End If
        
        '设置文本颜色
        If IsNumeric(.Value) Then
            If .Value >= ab1Val Then
                .Font.Color = vbGreen
            Else
                .Font.Color = vbRed
            End If
        End If
        
        '设置斜体格式
        .Font.Italic = (CBool(ws.Range("A40").Value) And controlVal1)
    End With
End Sub

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