Excel-VBA - 如果喜欢*值*，则为 X 轴点着色

Question

基本上，我有一个从 Java 动态创建的图表（使用 POI），并且我正在传递允许在图表中为特定点着色的值。

为此，我需要访问点值标签，以便测试条件属性是否适用于每个点值。

例如，我为 seriesPointObject 设置了变量

1. 系列名称
2. 点值名称
3. 条件
4. 颜色

我的伪代码如下

   For every seriesPointObject in the list
        Get all Values from Obj
        For Each series in the series collection
             Get Every point
                  For every point label
                      Check condition with point value
                          if condition test is true 
                                 series point change colour

但我无法访问每个系列的点值标签。点值标签和系列之间一定有联系，但我就是找不到。

有什么方法可以从系列对象中获取点标签文本？

Answer 1

这样的事情就可以解决问题

我有点惊讶我可以通过 VBA 访问每个图表系列的每个 Point，但 Point 没有直接值。解决方法是将整个图表系列转储到一个变量数组中，测试数组中的每个值是否超出测试条件，然后使用 chrSeries.Points(lngCnt) 格式化 Point

Sub FormatPoints()
    Dim chr As ChartObject
    Dim chrSeries As Series
    Dim X As Variant
    Dim lngCnt As Long
    Set chr = ActiveSheet.ChartObjects(1)
    For Each chrSeries In chr.Chart.SeriesCollection
        X = chrSeries.Values
        For lngCnt = 1 To UBound(X)
            If X(lngCnt) > 10 Then
                With chrSeries.Points(lngCnt)
                    .MarkerBackgroundColor = vbRed
                    .MarkerForegroundColor = vbBlue
                End With
            End If
        Next
    Next
End Sub

Answer 2

在上面的示例中，它运行良好，但是，如果我想针对 a、b、c 和 d 进行测试怎么办。说： if( pointLabel == "a" ){ Edit color of point } 我认为在我的问题中点标签和刻度标签之间有一点混淆，因为我想访问相关的 x 轴上的标签到该系列的重点。

你好科林

要访问数据点的数据值或点标签，您必须首先遍历每个数据点，然后检索值。

Dave 已经为您提供了一种检索 Y 值的方法。这是另一种获取 X 值和 Y 值的方法。

Sub FormatPoints()
    Dim chr As ChartObject
    Dim chrSeries As Series
    Dim X() As String
    Dim lngCnt As Long
    Dim pnt As Point
    Set chr = ActiveSheet.ChartObjects(1)


    For Each chrSeries In chr.Chart.SeriesCollection
        For Each pnt In chrSeries.Points
            pnt.DataLabel.ShowCategoryName = True
            X = Split(pnt.DataLabel.Caption, ",")

            '---- X Value ---------
            '~~> This will give you "A" for the above example
            '~~> which you can use for comparision
            Debug.Print X(0)

            '---- Y Value ---------
            '~~> This will give you 1
            Debug.Print X(1) ' OR

            pnt.DataLabel.ShowCategoryName = False
        Next
    Next
End Sub

编辑

如果数据点不可见，上述代码将失败。您也可以使用此代码。

Sub FormatPoints()
    Dim chr As ChartObject
    Dim chrSeries As Series
    Dim X() As String
    Dim lngCnt As Long
    Dim pnt As Point
    Set chr = ActiveSheet.ChartObjects(1)


    For Each chrSeries In chr.Chart.SeriesCollection
        For Each pnt In chrSeries.Points
            '~~> You need this line else the code will fail
            pnt.DataLabel.ShowValue = True

            pnt.DataLabel.ShowCategoryName = True
            X = Split(pnt.DataLabel.Caption, ",")
            pnt.DataLabel.ShowCategoryName = False

            MsgBox "X Value :" & X(0) & vbNewLine & "Y Value :" & X(1)
        Next
    Next
End Sub

快照

现在，如果您将 X 轴值设为“Sid, Rout”，则上述方法将不起作用。对于这些场景，我创建了一个额外的函数。请参阅下面的代码。

Sub FormatPoints()
    Dim chr As ChartObject
    Dim chrSeries As Series
    Dim X As String, Y As String
    Dim lngCnt As Long
    Dim pnt As Point
    Set chr = ActiveSheet.ChartObjects(1)


    For Each chrSeries In chr.Chart.SeriesCollection
        For Each pnt In chrSeries.Points
            '~~> You need this line else the code will fail
            pnt.DataLabel.ShowValue = True

            pnt.DataLabel.ShowCategoryName = True

            X = GetVal(pnt.DataLabel.Caption, "X")
            Y = GetVal(pnt.DataLabel.Caption, "Y")

            pnt.DataLabel.ShowCategoryName = False

            MsgBox "X Value :" & X & vbNewLine & "Y Value :" & Y
        Next
    Next
End Sub

Function GetVal(DataPointCaption As String, strAxis As String) As String
    Dim TempAr() As String

     TempAr = Split(DataPointCaption, ",")

     If strAxis = "Y" Then GetVal = TempAr(UBound(TempAr))
     If strAxis = "X" Then
        For i = LBound(TempAr) To (UBound(TempAr) - 1)
            GetVal = GetVal & "," & TempAr(i)
        Next i
        GetVal = Mid(GetVal, 2)
     End If
End Function

快照

HTH

席德