VBA同步条件格式颜色到条形图数据点 系列关联错误排查求助

原代码核心错误点 #

• 图表对象赋值错误：Chart.Refresh是无返回值的操作方法，无法直接赋值给xChart对象，导致xChart始终为空，代码直接终止运行
• 数据源范围匹配错误：原代码取系列数据源时默认使用ActiveSheet，但你的数据存放在其他工作表，会出现范围匹配失败
• 颜色取值逻辑错误：使用ColorIndex配合ThisWorkbook.Colors取色会受工作簿调色板配置影响，条件格式生成的颜色用该方式取值准确率极低
• 冗余变量无实际作用：定义的xRowsOrCols全程未参与逻辑运算，属于无效代码

修正后可运行代码 #

Sub CellColorsToChart()
    Dim xChart As Chart
    Dim I As Long, J As Long
    Dim xSCount As Long
    Dim xRg As Range, xCell As Range
    Dim xFormulaParts As Variant, xSheetName As String
    
    ' 先获取图表对象，再单独执行刷新
    Set xChart = ActiveSheet.ChartObjects("Net Internal Area").Chart
    If xChart Is Nothing Then Exit Sub
    xChart.Refresh
    
    xSCount = xChart.SeriesCollection.Count
    
    For I = 1 To xSCount
        J = 1
        With xChart.SeriesCollection(I)
            ' 拆分系列公式，获取对应的数据源工作表和范围，避免依赖ActiveSheet
            xFormulaParts = Split(.Formula, ",")
            xSheetName = Split(xFormulaParts(2), "!")(0)
            ' 去掉工作表名两端的单引号（工作表名带空格时会自动加单引号）
            xSheetName = Replace(xSheetName, "'", "")
            Set xRg = ThisWorkbook.Sheets(xSheetName).Range(Split(xFormulaParts(2), "!")(1))
            
            For Each xCell In xRg
                ' 直接取条件格式渲染后的实际RGB颜色，无需转换ColorIndex
                .Points(J).Format.Fill.ForeColor.RGB = xCell.DisplayFormat.Interior.Color
                .Points(J).Format.Line.ForeColor.RGB = xCell.DisplayFormat.Interior.Color
                J = J + 1
            Next
        End With
    Next
End Sub

使用与代码理解说明 #

原代码的核心逻辑是可行的：遍历图表所有系列，拆分系列公式找到对应的数据源单元格，再把单元格的颜色同步给对应的图表数据点，故障均来自语法错误和边界场景适配缺失。
修正后的代码建议绑定到下拉列表的「更改事件」上，每次切换Lab/Office选项时自动运行，即可实现图表颜色和单元格条件格式颜色的实时同步。如果图表系列的数据源存在合并单元格等特殊格式，可额外添加判断逻辑跳过空值对应的图表点即可。

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