Excel VBA，基于系列值比较选择图表颜色_Vba_Excel_Charts

Excel VBA，基于系列值比较选择图表颜色

vba excel charts

Excel VBA，基于系列值比较选择图表颜色,vba,excel,charts,Vba,Excel,Charts,我有一些代码，我已经用它给excel图表上色好几年了，它工作得很好（尽管可能有更好的方法）。图表包含两个系列，第一个系列带有值，第二个系列带有目标。目标不会着色，但vba会根据vba中硬编码的目标循环第一个系列和颜色我现在的问题是，我添加了一个图表，该图表的目标可以每月更改，因此硬编码不起作用。如何使用相同的理论，但直接将系列1数据与系列2数据进行比较，以确定颜色（情况是系列1点>系列2点，等等）。我已经尝试了很多方法，但都没有成功，所以我非常感谢您的帮助。下面是经过验证的技术的代码 Priv

我有一些代码，我已经用它给excel图表上色好几年了，它工作得很好（尽管可能有更好的方法）。图表包含两个系列，第一个系列带有值，第二个系列带有目标。目标不会着色，但vba会根据vba中硬编码的目标循环第一个系列和颜色

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

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
V = cht.Chart.SeriesCollection(1).Values
For Each p In cht.Chart.SeriesCollection(1).Points
Counter = Counter + 1
Select Case V(Counter)

'Case Is = 1
   '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

Case Is < 0.98
    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

'Case Is < 0.98
    '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

Case Is <= 1
    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
Next
End Sub

Private子工作表\u Activate（）
作为对象的Dim-cht
将p作为对象
Dim V作为变体
作为整数的Dim计数器
对于ActiveSheet.ChartObjects中的每个cht
计数器=0
V=cht.Chart.SeriesCollection（1）值
对于cht.Chart.SeriesCollection（1）中的每个p点
计数器=计数器+1
选择案例V（计数器）
“情况是=1
'p.Shadow=False
'p.InvertIfNegative=False
'p.Fill.OneColorGradient样式：=msoGradientVertical，变量：=3_
“度：=0.78
'p.Fill.Visible=True
'p.Fill.ForeColor.SchemeColor=5
病例<0.98
p、 阴影=假
p、 阴性=假
p、 Fill.OneColorGradient样式：=msoGradientVertical，变量：=3_
度：=0.78
p、 Fill.Visible=True
p、 Fill.ForeColor.SchemeColor=3
'病例<0.98
'p.Shadow=False
'p.InvertIfNegative=False
'p.Fill.OneColorGradient样式：=msoGradientVertical，变量：=4_
“度：=0.38
'p.Fill.Visible=True
'p.Fill.ForeColor.SchemeColor=6
案例是您是否尝试过以下方法：
大小写为>.SeriesCollection（2）.Values（）（计数器）

还进行了修改，以消除一些明显的冗余（如果需要一个循环和一个计数器变量，例如，在并行循环多个集合/数组时），IMO最好只按索引循环，而不是使用单独的计数器对每个对象进行
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

使用最终代码编辑，渐变需要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

Private子工作表\u Activate（）
作为对象的Dim-cht
将p作为对象
Dim V作为变体
作为整数的Dim计数器
作为整数的Dim L
对于L=1到2
对于ActiveSheet.ChartObjects中的每个cht
计数器=0
有红隧图
V=cht.Chart.SeriesCollection（1）值
对于计数器=1到.SeriesCollection（1）.Points.Count
设置p=.SeriesCollection（1）.点（计数器）
选择案例V（计数器）
“蓝色梯度
'大小写为=.SeriesCollection（2）.Values（）（计数器）
'p.Shadow=False
'p.InvertIfNegative=False
'p.Fill.OneColorGradient样式：=msoGradientVertical，变量：=3_
“度：=0.78
'p.Fill.Visible=True
'p.Fill.ForeColor.SchemeColor=5
“红色梯度
大小写为<.SeriesCollection（2）.Values（）（计数器）
p、 阴影=假
p、 阴性=假
p、 Fill.OneColorGradient样式：=msoGradientVertical，变量：=3_
度：=0.78
p、 Fill.Visible=True
p、 Fill.ForeColor.SchemeColor=3
“黄色梯度
'大小写为<.SeriesCollection（2）.Values（）（计数器）
'p.Shadow=False
'p.InvertIfNegative=False
'p.Fill.OneColorGradient样式：=msoGradientVertical，变量：=4_
“度：=0.38
'p.Fill.Visible=True
'p.Fill.ForeColor.SchemeColor=6
“绿色梯度
大小写为>=.SeriesCollection（2）.Values（）（计数器）
p、 阴影=假
p、 阴性=假
p、 Fill.OneColorGradient样式：=msoGradientVertical，变量：=3_
度：=0.78
p、 Fill.Visible=True
p、 Fill.ForeColor.SchemeColor=10
结束选择
下一个
以
下一个
下一个L
端接头
David，感谢您的快速响应。我进行了调整并理解了这个想法，但仍然出现了运行时错误。为了尝试，我为series 2的值创建了一个变量，并对此进行了尝试，但得到了相同的错误。请参阅修订版：Case Is>.SeriesCollection（2）.Values（）（计数器）
运行时错误“451”：未定义属性let过程，并且属性get过程未返回object@BruceWayneSeries
对象的Values
属性返回一个数组，因此它只需通过索引访问元素。是的，您可以对\u range\uu.Value（）（\u row\u index，\u column\u index）
执行相同的操作，但最好只执行range（“A1”）（\u row\u index，\u column\u index）
。它依赖于范围
的默认值，即单元格
范围，并返回索引单元格的默认属性（.value
）。它也不会引发索引越界错误，因此您可以执行[A1]（1,4）
来获取