来自非连续行的 Excel VBA 中 XY 图表的数据标签

Question

我想使用不连续的行将 xy 图标记为来自单独的 serie 集合的一张图表，如下图所示，一张是红色，另一张是蓝色。

下面的代码有错误：

Sub AddDataLabels3()
Dim curLabel As Integer: curLabel = 1
Dim rwCount As Integer
Dim rngArea As Range

'Enable error handling
On Error Resume Next
 
'Display an inputbox and ask the user for a cell range
Set Rng1 = Application.InputBox(prompt:="Select cells to link" _
    , Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)
Set Rng2 = Application.InputBox(prompt:="Select cells to link" _
    , Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)
Set Rng = Union(Rng1, Rng2)
'Disable error handling
On Error GoTo 0
'Rng.Count = 1
With ActiveChart
    If Rng.Areas.Count > 1 Then
    'Debug.Print "It's a non-contiguous range"
    For Each rngArea In Rng.Areas
        rwCount = rwCount + rngArea.Rows.Count
    Next
    End If
    'Iterate through each series in chart
    For Each ChSer In .SeriesCollection

        'Save chart point to object SerPo
        Set SerPo = ChSer.Points

        'Save the number of points in chart to variable j
        j = SerPo.Count

        'Iterate though each point in current series
        For i = 1 To j

            'Enable data label for current chart point
            SerPo(i).ApplyDataLabels Type:=xlShowValue

            'Save cell reference to chart point
            SerPo(i).DataLabel.FormulaLocal = Rng.Areas(rwCount).Cells(curLabel).FormulaLocal
            '& rng.Cells(i).Reference(ReferenceStyle:=xlR1C1)
            
            ' Next label
            curLabel = curLabel + 1
            'Rng.Count = Rng.Count + 1
            
        Next
    Next
End With
End Sub

错误在线：

SerPo(i).DataLabel.FormulaLocal = Rng.Areas(rwCount).Cells(curLabel).FormulaLocal

如何解决这个问题，你能帮帮我吗？

Answer 1

您获得了 rng1 和 rng2 的两个数据标签范围。我根据 PlotOrder 属性使用 rng 为 rng1 或 rng2，这是系列在“Select 数据源”中显示的顺序。

注意：使用 Option Explict

始终是一个好习惯

Option Explicit

Sub AddDataLabels3()
    Dim rng As Range, rng1 As Range, rng2 As Range
    Dim ChSer As Series
    Dim SerPo As Object
    Dim i As Byte, j As Byte
    
    'Enable error handling
    On Error Resume Next
     
    'Display an inputbox and ask the user for a cell range
    Set rng1 = Application.InputBox(prompt:="Select cells to link" _
        , Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)  ' Series1 -> PlotOrder = 1
        
    Set rng2 = Application.InputBox(prompt:="Select cells to link" _
        , Title:="Select data label values", Default:=ActiveCell.Address, Type:=8)  ' Series2 -> PlotOrder = 2
    
    'Disable error handling
    On Error GoTo 0
    
    With ActiveChart
        'Iterate through each series in chart
        For Each ChSer In .SeriesCollection
            If ChSer.PlotOrder = 1 Then
                Set rng = rng1
            Else
                Set rng = rng2
            End If
    
            'Save chart point to object SerPo
            Set SerPo = ChSer.Points
    
            'Save the number of points in chart to variable j
            j = SerPo.Count
    
            'Iterate though each point in current series
            For i = 1 To j
    
                'Enable data label for current chart point
                SerPo(i).ApplyDataLabels Type:=xlShowValue
    
                'Save cell reference to chart point
                SerPo(i).DataLabel.FormulaLocal = rng.Cells(i).FormulaLocal
            Next
        Next
    End With
End Sub

来自非连续行的 Excel VBA 中 XY 图表的数据标签

Datalabel for XY chart in Excel VBA from non-contigous rows

excel

vba

labeling