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

Question

我有一些代码，我已经使用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 

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