Excel VBA，根据系列值比较select图表颜色
我有一些代码，我已经使用了多年的Excel图表颜色，它运行良好，（虽然有可能有更好的方法来做到这一点）。 图表包含2个系列，第一个系列有价值，第二个系列有一个目标。 目标不会被着色，但是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 你有没有尝试类似的东西：
Case Is > .SeriesCollection(2).Values()(Counter)
还修改了摆脱一些明显的冗余（如果需要一个循环和一个计数器variables，例如，当并行循环几个集合/数组），似乎更好的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的值，否则可以进一步减less：
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次刷新才能完全填充，（我将不得不打另一个选项卡，然后返回），所以我添加了一个循环来运行代码两次，现在它第一次更新完美。 希望这可以帮助别人。 这允许一个完全dynamic的图表。 再次感谢大卫。
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