Excel VBA 为XY散点图设置非连续行数据标签报错如何解决

核心报错原因 #

你代码里的rwCount变量是用来统计所有选中区域的总行数，你却把它作为Rng.Areas的索引参数，必然出现索引越界：比如你选2个区域各3行，rwCount最终值为6，但Rng.Areas只有2个元素，访问Rng.Areas(6)完全超出集合范围，所以触发报错。同时原代码没有做序列和对应标签区域的匹配逻辑，就算索引修复也会出现标签和序列不对应的问题。

修复后代码 #

Sub AddDataLabels3()
    Dim SerIdx As Integer
    Dim PointIdx As Integer
    Dim LabelRng1 As Range
    Dim LabelRng2 As Range
    
    ' 开启错误处理避免用户点取消报错
    On Error Resume Next
    ' 依次选择两个序列对应的标签区域，第一个输入框选第一个序列的标签，第二个选第二个序列的标签
    Set LabelRng1 = Application.InputBox(prompt:="选择第一个序列对应的数据标签单元格", _
        Title:="选择标签区域", Default:=ActiveCell.Address, Type:=8)
    Set LabelRng2 = Application.InputBox(prompt:="选择第二个序列对应的数据标签单元格", _
        Title:="选择标签区域", Default:=ActiveCell.Address, Type:=8)
    On Error GoTo 0
    
    ' 判断是否选中了有效区域、当前是否激活了图表
    If LabelRng1 Is Nothing Or LabelRng2 Is Nothing Or ActiveChart Is Nothing Then
        MsgBox "请先选中目标图表，且正确选择两个标签区域", vbExclamation
        Exit Sub
    End If
    
    With ActiveChart
        ' 遍历两个序列
        For SerIdx = 1 To 2
            With .SeriesCollection(SerIdx)
                ' 校验标签区域行数和序列点数是否匹配
                If IIf(SerIdx = 1, LabelRng1.Cells.Count, LabelRng2.Cells.Count) <> .Points.Count Then
                    MsgBox "第" & SerIdx & "个序列的点数和对应标签区域的单元格数量不匹配", vbExclamation
                    Exit Sub
                End If
                ' 遍历序列所有点加标签
                For PointIdx = 1 To .Points.Count
                    .Points(PointIdx).ApplyDataLabels Type:=xlShowValue
                    ' 对应绑定标签单元格
                    .Points(PointIdx).DataLabel.FormulaLocal = IIf(SerIdx = 1, LabelRng1.Cells(PointIdx).FormulaLocal, LabelRng2.Cells(PointIdx).FormulaLocal)
                Next
            End With
        Next
    End With
End Sub

使用注意事项 #

• 运行代码前先选中目标散点图
• 第一个弹出的输入框选择图表第一个序列（按你图表序列顺序，通常先加的是第一个）对应的标签单元格，第二个弹出的输入框选择第二个序列对应的标签单元格
• 每个标签区域的单元格数量要和对应序列的点数完全一致，否则会触发匹配提示

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