如何用单个VBA函数实现多行实际销售单元格基于目标行的格式设置？

我有一份销售数据表，需要实现以下格式设置需求：

• 每月销售目标行的下方是实际销售额行，每个实际销售额单元格需与上方对应目标行单元格对比：
  • 未达标：设置浅红色填充
  • 达标或超额：设置浅绿色填充
  • 空单元格：清除格式

当前编写的VBA代码仅能正常处理单行（如A3:L3），新增多行实际销售额行（如A9:L9）后无法正常工作。尝试用集合实现多行列处理时触发了范围溢出错误，想知道能否通过单个函数实现多行列的格式设置需求。

当前VBA代码：

Sub FormattingNumValue()

Dim i As Range
For Each i In Range("A3:L3")
    If IsEmpty(i.Value) = False Then
        If (i.Value < i.Offset(-1, 0).Value) Then
            i.Interior.Color = RGB(255, 199, 206)
        Else
            i.Interior.Color = RGB(198, 239, 206)
        End If
    Else
        i.ClearFormats
    End If
Next i
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Check if cell was changed and call Update function/procedure
    If Not Intersect(Target, Range("A3:L3")) Is Nothing Or Not Intersect(Target, Range("A9:L9")) Is Nothing Then
        'MsgBox "Something changed"
       Call FormattingNumValue
    End If
End Sub

可以通过修改代码，用数组管理所有实际销售额行的方式实现多行列处理，无需集合，避免溢出问题。以下是优化后的代码：

Sub FormattingNumValue()
    Dim actualRows As Variant
    Dim rowNum As Long
    Dim cell As Range
    
    ' 在这里添加所有实际销售额的行号，新增行直接追加到数组即可
    actualRows = Array(3, 9)
    
    ' 遍历每一行实际销售额
    For Each rowNum In actualRows
        ' 处理当前行的A到L列单元格
        For Each cell In Me.Range("A" & rowNum & ":L" & rowNum)
            If IsEmpty(cell.Value) Then
                cell.ClearFormats
            Else
                ' 对比上方目标行的对应单元格
                If cell.Value < cell.Offset(-1, 0).Value Then
                    cell.Interior.Color = RGB(255, 199, 206) ' 浅红色填充
                Else
                    cell.Interior.Color = RGB(198, 239, 206) ' 浅绿色填充
                End If
            End If
        Next cell
    Next rowNum
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim actualRows As Variant
    Dim rowNum As Long
    Dim watchRange As Range
    
    actualRows = Array(3, 9)
    ' 初始化监听范围为第一行实际销售额
    Set watchRange = Me.Range("A" & actualRows(0) & ":L" & actualRows(0))
    
    ' 合并所有实际销售额行的监听范围
    For rowNum = LBound(actualRows) + 1 To UBound(actualRows)
        Set watchRange = Union(watchRange, Me.Range("A" & rowNum & ":L" & rowNum))
    Next rowNum
    
    ' 同时监听目标行（实际行的上一行），目标值变化时也需要重新格式化
    Set watchRange = Union(watchRange, watchRange.Offset(-1, 0))
    
    ' 当修改的单元格在监听范围内时，执行格式化
    If Not Intersect(Target, watchRange) Is Nothing Then
        FormattingNumValue
    End If
End Sub

关键优化点 #

• 用数组actualRows统一管理所有实际销售额行号，新增行时只需在数组中添加对应行号，无需修改循环逻辑
• 遍历数组中的每一行，逐个处理单元格，避免硬编码单行范围
• 扩展Worksheet_Change的监听范围，同时包含实际销售额行和对应的目标行，确保目标值变化时也能自动更新格式
• 移除集合使用，避免范围溢出问题

内容的提问来源于stack exchange，提问作者KEC-IT