如何修改Excel VBA代码为XY散点图添加适配多段序列的自定义数据标签

问题原因 #

原代码存在两点适配缺陷：

1. 遍历所有图表序列时，每个序列的点都会从选中的标签区域第一个单元格重新开始取数，多段序列拼接、共用连续纵向标签时会出现标签重复错位。
2. 未做区域边界校验，标签区域单元格数少于序列点数时会出现赋值错误。

修改后代码 #

Sub AddDataLabels()
    Dim Rng As Range
    Dim ChSer As Series
    Dim SerPo As Points
    Dim i As Long, j As Long, labelIndex As Long
    
    ' 选择标签单元格区域
    On Error Resume Next
    Set Rng = Application.InputBox(prompt:="选择要绑定的标签单元格区域", _
    Title:="选择数据标签值", Default:=ActiveCell.Address, Type:=8)
    On Error GoTo 0
    
    If Rng Is Nothing Then Exit Sub ' 未选择区域直接退出
    
    labelIndex = 1 ' 全局标签索引，适配连续纵向排布的标签
    
    With ActiveChart
        For Each ChSer In .SeriesCollection
            Set SerPo = ChSer.Points
            j = SerPo.Count
            For i = 1 To j
                SerPo(i).ApplyDataLabels Type:=xlShowValue
                ' 按从上到下顺序取纵向区域标签，超出区域则停止赋值
                If labelIndex <= Rng.Cells.Count Then
                    SerPo(i).DataLabel.FormulaLocal = Rng.Cells(labelIndex).FormulaLocal
                    labelIndex = labelIndex + 1
                End If
            Next i
        Next ChSer
    End With
End Sub

修改说明 #

• 新增全局标签索引labelIndex，所有序列的点按顺序连续提取选中区域的标签，不会每个序列都从头开始取数，完美适配多段序列拼接、标签纵向连续排布的场景。
• 新增区域边界判断，避免标签区域单元格数少于点数时报错。
• 保留原有的单元格公式绑定逻辑，标签会随单元格内容自动更新。

内容的提问来源于stack exchange，提问作者A. Kaymakci