Excel VBA：新增数据时自动为条形图新条形着色的实现方法

嘿，这个需求很实用！咱们只需要通过循环遍历图表的所有数据点，并将每个数据点对应到D列的单元格，就能实现新增条形自动着色的效果。下面是具体的实现步骤：

1. 修改着色宏，遍历所有数据点 #

把你原有的ColorGraphs过程改成循环版本，让它处理所有数据点——不管是原来的还是新增的：

Sub ColorGraphs()
    Dim ChrtObj As ChartObject
    Dim Ser As Series
    Dim SerPoint As Point
    Dim i As Integer
    Dim targetCell As Range
    
    ' 替换成你的图表所在工作表和图表名称
    Set ChrtObj = ThisWorkbook.Sheets("Sheet1").ChartObjects("Chart 1")
    
    ' 遍历图表中的每个数据系列（条形图通常只有1个系列，保险起见全遍历）
    For Each Ser In ChrtObj.Chart.SeriesCollection
        ' 遍历当前系列的每一个数据点
        For i = 1 To Ser.Points.Count
            ' 对应数据单元格：第i个数据点对应D111+i（比如i=1对应D112，i=2对应D113）
            Set targetCell = ThisWorkbook.Sheets("Sheet1").Range("D" & 111 + i)
            
            ' 这里替换成你原有的着色逻辑，下面是示例
            Set SerPoint = Ser.Points(i)
            Select Case targetCell.Value
                Case Is > 100
                    SerPoint.Format.Fill.ForeColor.RGB = RGB(0, 255, 0) ' 数值>100时设为绿色
                Case 50 To 100
                    SerPoint.Format.Fill.ForeColor.RGB = RGB(255, 255, 0) ' 50-100设为黄色
                Case Else
                    SerPoint.Format.Fill.ForeColor.RGB = RGB(255, 0, 0) ' 其他设为红色
            End Select
        Next i
    Next Ser
End Sub

2. 添加自动触发事件 #

为了让新增数据后自动执行着色，我们可以用工作表的Worksheet_Change事件——当D列的目标单元格（D112及以下）被修改时，自动运行宏：

1. 右键点击工作表标签（比如Sheet1），选择「查看代码」
2. 在打开的代码窗口中粘贴以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 检测修改的单元格是否在D112到D列最后一行的范围内
    Dim dataRange As Range
    Set dataRange = Me.Range("D112:D" & Me.Cells(Me.Rows.Count, "D").End(xlUp).Row)
    
    If Not Intersect(Target, dataRange) Is Nothing Then
        ' 执行着色宏
        ColorGraphs
    End If
End Sub

关键注意事项 #

• 请根据你的实际情况修改：工作表名称（Sheet1）、图表名称（Chart 1）、单元格起始行（111+i，如果第一个数据点对应D110，就改成109+i）
• 着色逻辑部分（Select Case）可以完全替换成你原来的代码，保证和之前的着色规则一致
• 如果你的条形图有多个数据系列，这段代码也能兼容，会遍历所有系列的所有数据点

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