基于下拉列表值动态高亮数据透视图表条形颜色的技术问题

原代码失效的核心原因包括：错误指定目标图表、未重置条形默认颜色、直接读取Series.XValues存在匹配风险，以下是修复并优化后的完整方案：

修正后的颜色设置宏 #

Sub color_chart()
    Dim c As Chart
    Dim s As Series
    Dim iPoint As Long
    Dim targetName As String
    Dim pivotCat As Variant
    Dim pt As PivotTable
    
    ' 获取C4目标值，空值直接退出
    targetName = Trim(Range("C4").Value)
    If targetName = "" Then Exit Sub
    
    ' 直接引用目标Chart3，避免激活操作（替换"你的工作表名称"为实际表名）
    Set c = ThisWorkbook.Sheets("你的工作表名称").ChartObjects("Chart3").Chart
    Set s = c.SeriesCollection(1)
    
    ' 关联目标数据透视表PivotTable2
    Set pt = ThisWorkbook.Sheets("你的工作表名称").PivotTables("PivotTable2")
    
    ' 先将所有条形重置为蓝色
    For iPoint = 1 To s.Points.Count
        s.Points(iPoint).Interior.Color = RGB(0, 120, 215)
    Next iPoint
    
    ' 遍历透视表分类项，匹配后设置对应条形为红色（假设分类字段为"员工姓名"）
    For iPoint = 1 To pt.PivotFields("员工姓名").PivotItems.Count
        pivotCat = pt.PivotFields("员工姓名").PivotItems(iPoint).Name
        If Trim(pivotCat) = targetName Then
            s.Points(iPoint).Interior.Color = RGB(255, 78, 0)
            Exit For ' 匹配成功后终止循环
        End If
    Next iPoint
End Sub

关键优化点 #

• 移除Activate操作，通过对象直接引用图表，避免激活带来的不稳定
• 先重置所有条形为蓝色，确保切换下拉选项时旧高亮项自动恢复默认
• 直接从关联的PivotTable2读取分类值，解决XValues的类型匹配问题
• 增加空值判断，避免C4为空时触发无效操作

实现动态切换效果 #

要让下拉列表选择时自动更新条形颜色，在对应工作表的模块中添加Change事件：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅当C4单元格变化时触发宏
    If Not Intersect(Target, Range("C4")) Is Nothing Then
        color_chart
    End If
End Sub

设置步骤 #

1. 右键点击包含C4的工作表标签 → 选择「查看代码」
2. 在弹出的代码窗口中粘贴上述事件代码
3. 将工作簿保存为.xlsm格式（启用宏的工作簿）

注意事项 #

• 替换代码中的"你的工作表名称"为实际包含图表和透视表的工作表名称
• 如果透视表的分类字段是列字段而非行字段，需调整pt.PivotFields("员工姓名")的引用逻辑
• 确保C4下拉列表的选项与透视表中的员工姓名完全匹配（无空格、大小写一致）

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