基于单元格颜色的VBA着色条形图 - 多个条形

Question

有人可以帮忙检查为什么单元格颜色不适用于所有条形吗？我在图表中包含了 2 个月的数据，但颜色仅适用于 1 个月，而不是两者都适用

我希望单元格颜色适用于两个条形。下面是我从一个复制的代码 回答。

Sub ColorAnItem()

    Dim i As Long, rng As Range, chrt As Chart
    
    Set chrt = ActiveSheet.ChartObjects(1).Chart
    Set rng = ActiveSheet.Range("B2:B27")
    
    For i = 1 To rng.Cells.Count
        
        chrt.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = _
                    rng.Cells(i).Interior.Color
        
    Next i

End Sub

Answer 1

您的数据表是“原始”的，并且您的图表是汇总的，因此从 B2:B27 中的一个单元格到图表上的条形图之间不存在 1:1 映射。

您需要循环图表上每个系列中的点，获取其类别/类，然后在原始数据表中找到相同的值并复制该单元格的填充颜色。

Sub Tester()
    Dim cht As Chart, ser As Series, pt As Point, i As Long, x
    Dim rngLabels As Range, m As Variant
    
    Set cht = ActiveSheet.ChartObjects(1).Chart
    Set rngLabels = ActiveSheet.Range("C4:C21") 'raw data x values
    
    'check each chart series
    For Each ser In cht.SeriesCollection
        'loop over the series points
        For i = 1 To ser.Points.Count
            x = ser.XValues(i) 'get the x value (category)
            m = Application.Match(x, rngLabels, 0)
            If Not IsError(m) Then
                'if got a match, copy the cell fill color
                ser.Points(i).Format.Fill.ForeColor.RGB = _
                    rngLabels.Cells(m).Interior.Color
            End If
        Next i
    Next ser
End Sub

我的测试数据和图表：