Question

我已经使用了一些代码来为excel图表着色很多年并且它运行良好，（尽管可能有更好的方法）。图表包含2个系列，第一个系列带有值，第二个带有目标。目标没有变色，但vba循环通过第一个系列和颜色根据vba中的硬编码目标。

我现在遇到的问题是我添加了一个图表，其目标可以逐月更改，因此硬编码不起作用。我如何使用相同的理论，但将系列1数据直接与系列2数据进行比较以确定颜色，（Case Is系列1点＆gt;系列2点等）。我已经尝试了很多方法但没有成功，所以我们将非常感谢任何帮助。下面是经过验证的技术的代码。

Dog

Answer 1

您尝试过类似的事情吗？

Case Is > .SeriesCollection(2).Values()(Counter)

还修改了以消除一些明显的冗余（如果需要一个循环和一个计数器变量，例如，当并行循环几个集合/数组时），通过索引循环似乎更好的IMO ，而不是For Each _object_有一个单独的计数器。

Private Sub Worksheet_Activate()
Dim cht As Object
Dim p As Object
Dim V As Variant
Dim Counter As Integer

For Each cht In ActiveSheet.ChartObjects
    Counter = 0
    With cht.Chart
        V = .SeriesCollection(1).Values
        For Counter = 1 to.SeriesCollection(1).Points.Count

            'Assign your Point object, if needed elsewhere
            Set p = .SeriesCollection(1).Points(Counter)

            Select Case V(Counter)

                Case Is > .SeriesCollection(2).Values()(Counter)
                'DO STUFF HERE.

                'Add other cases if needed...

            End Select
        Next
    End With
Next
End Sub

除非您因某些其他原因需要数组V中的值，否则可以进一步减少：

Private Sub Worksheet_Activate()
Dim cht As Object
Dim p As Object
Dim val1, val2
Dim Counter As Integer

For Each cht In ActiveSheet.ChartObjects
    Counter = 0
    With cht.Chart
        For Counter = 1 to.SeriesCollection(1).Points.Count

            'Assign your Point object, if needed elsewhere
            Set p = .SeriesCollection(1).Points(Counter)
            ' extract specific point value to variables:
            val1 = .SeriesCollection(1).Values()(Counter)
            val2 = .SeriesCollection(2).Values()(Counter)
            Select Case V(Counter)

                Case  val1 > val2
                'DO STUFF HERE.

                'Add other cases if needed...

            End Select
        Next
    End With
Next
End Sub

Answer 2

使用最终代码编辑，渐变需要2次刷新才能完全填充，（我必须点击另一个选项卡然后返回），所以我添加了一个循环来运行代码两次，现在它更新完美第一次时间。希望这有助于其他人。这允许完全动态的图表。再次，谢谢大卫。

Private Sub Worksheet_Activate()
Dim cht As Object
Dim p As Object
Dim V As Variant
Dim Counter As Integer
Dim L As Integer

For L = 1 To 2

    For Each cht In ActiveSheet.ChartObjects
        Counter = 0
        With cht.Chart
            V = cht.Chart.SeriesCollection(1).Values
            For Counter = 1 To .SeriesCollection(1).Points.Count
                Set p = .SeriesCollection(1).Points(Counter)

                Select Case V(Counter)

                'Blue Gradient
                    'Case Is = .SeriesCollection(2).Values()(Counter)
                         'p.Shadow = False
                         'p.InvertIfNegative = False
                         'p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, _
                         '    Degree:=0.78
                         'p.Fill.Visible = True
                         'p.Fill.ForeColor.SchemeColor = 5

                'Red Gradient
                    Case Is < .SeriesCollection(2).Values()(Counter)
                        p.Shadow = False
                        p.InvertIfNegative = False
                        p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, _
                            Degree:=0.78
                        p.Fill.Visible = True
                        p.Fill.ForeColor.SchemeColor = 3

                'Yellow Gradient
                    'Case Is < .SeriesCollection(2).Values()(Counter)
                        'p.Shadow = False
                        'p.InvertIfNegative = False
                        'p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, _
                        '    Degree:=0.38
                        'p.Fill.Visible = True
                        'p.Fill.ForeColor.SchemeColor = 6

                'Green Gradient
                    Case Is >= .SeriesCollection(2).Values()(Counter)
                        p.Shadow = False
                        p.InvertIfNegative = False
                        p.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, _
                            Degree:=0.78
                        p.Fill.Visible = True
                        p.Fill.ForeColor.SchemeColor = 10

                End Select
            Next
        End With
    Next
Next L
End Sub

Excel VBA，根据系列值比较选择图表颜色

2 个答案: