Excel VBA 实现散点图添加数组自定义数据标签的方法

问题描述 #

我正在编写Excel VBA代码，调用已存储在数组中的数据自动生成图表，当前宏运行生成的图表效果如下：

现有实现代码如下：

Dim sht As Worksheet
Set sht = ActiveSheet
Dim chtObj As ChartObject
Set chtObj = sht.ChartObjects.Add(100, 10, 500, 300)
Dim cht As Chart
Set cht = chtObj.Chart

If IsZeroLengthArray(yData_TSI) = False Then
    Dim ser As Series
    Set ser = cht.SeriesCollection.NewSeries
    ser.Values = yData_TSI
    ser.XValues = xData_TSI
    ser.Name = "TSI Predicant"
    ser.ChartType = xlXYScatterSmooth
End If
If IsZeroLengthArray(yData_Pallet) = False Then
    Dim ser2 As Series
    Set ser2 = cht.SeriesCollection.NewSeries
    ser2.Values = yData_Pallet
    ser2.XValues = xData_Pallet
    ser2.Name = "Pallet Decant"
    ser2.ChartType = xlXYScatterSmooth
End If
If IsZeroLengthArray(yData_Vendor) = False Then
    Dim ser3 As Series
    Set ser3 = cht.SeriesCollection.NewSeries
    ser3.Values = yData_Vendor
    ser3.XValues = xData_Vendor
    ser3.Name = "Vendor Decant"
    ser3.ChartType = xlXYScatterSmooth
End If
If IsZeroLengthArray(yData_Prep) = False Then
    Dim ser4 As Series
    Set ser4 = cht.SeriesCollection.NewSeries
    ser4.Values = yData_Prep
    ser4.XValues = xData_Prep
    ser4.Name = "Each"
    ser4.ChartType = xlXYScatterSmooth
End If
If IsZeroLengthArray(yData_Each) = False Then
    Dim ser5 As Series
    Set ser5 = cht.SeriesCollection.NewSeries
    ser5.Values = yData_Each
    ser5.XValues = xData_Each
    ser5.Name = "Prep"
    ser5.ChartType = xlXYScatterSmooth
End If

另有一组tData_XXX数组，存储需要标注在图表对应数据点上的数值，同系列的xData_XXX、yData_XXX、tData_XXX三类数组长度始终一致。例如Vendor Decant系列对应的tData_Vendor数组存储值为(34,5,12)时，需要在该系列的三个散点旁分别标注对应数值，预期效果如下：

备注：所有同系列的yData_XXX、xData_XXX、tData_XXX数组长度始终保持一致

实现代码 #

只需要在每个系列创建完成后开启数据标签，逐点将标签文本替换为对应tData_XXX数组的值即可，修改后的完整代码如下：

Dim sht As Worksheet
Set sht = ActiveSheet
Dim chtObj As ChartObject
Set chtObj = sht.ChartObjects.Add(100, 10, 500, 300)
Dim cht As Chart
Set cht = chtObj.Chart
Dim i As Long ' 数据点遍历变量

' TSI系列
If IsZeroLengthArray(yData_TSI) = False Then
    Dim ser As Series
    Set ser = cht.SeriesCollection.NewSeries
    ser.Values = yData_TSI
    ser.XValues = xData_TSI
    ser.Name = "TSI Predicant"
    ser.ChartType = xlXYScatterSmooth
    ' 绑定自定义标签
    ser.ApplyDataLabels Type:=xlDataLabelsShowValue
    For i = 1 To UBound(tData_TSI) - LBound(tData_TSI) + 1
        ser.Points(i).DataLabel.Text = tData_TSI(LBound(tData_TSI) + i - 1)
    Next i
End If

' Pallet系列
If IsZeroLengthArray(yData_Pallet) = False Then
    Dim ser2 As Series
    Set ser2 = cht.SeriesCollection.NewSeries
    ser2.Values = yData_Pallet
    ser2.XValues = xData_Pallet
    ser2.Name = "Pallet Decant"
    ser2.ChartType = xlXYScatterSmooth
    ' 绑定自定义标签
    ser2.ApplyDataLabels Type:=xlDataLabelsShowValue
    For i = 1 To UBound(tData_Pallet) - LBound(tData_Pallet) + 1
        ser2.Points(i).DataLabel.Text = tData_Pallet(LBound(tData_Pallet) + i - 1)
    Next i
End If

' Vendor系列
If IsZeroLengthArray(yData_Vendor) = False Then
    Dim ser3 As Series
    Set ser3 = cht.SeriesCollection.NewSeries
    ser3.Values = yData_Vendor
    ser3.XValues = xData_Vendor
    ser3.Name = "Vendor Decant"
    ser3.ChartType = xlXYScatterSmooth
    ' 绑定自定义标签
    ser3.ApplyDataLabels Type:=xlDataLabelsShowValue
    For i = 1 To UBound(tData_Vendor) - LBound(tData_Vendor) + 1
        ser3.Points(i).DataLabel.Text = tData_Vendor(LBound(tData_Vendor) + i - 1)
    Next i
End If

' Each系列
If IsZeroLengthArray(yData_Prep) = False Then
    Dim ser4 As Series
    Set ser4 = cht.SeriesCollection.NewSeries
    ser4.Values = yData_Prep
    ser4.XValues = xData_Prep
    ser4.Name = "Each"
    ser4.ChartType = xlXYScatterSmooth
    ' 绑定自定义标签
    ser4.ApplyDataLabels Type:=xlDataLabelsShowValue
    For i = 1 To UBound(tData_Prep) - LBound(tData_Prep) + 1
        ser4.Points(i).DataLabel.Text = tData_Prep(LBound(tData_Prep) + i - 1)
    Next i
End If

' Prep系列
If IsZeroLengthArray(yData_Each) = False Then
    Dim ser5 As Series
    Set ser5 = cht.SeriesCollection.NewSeries
    ser5.Values = yData_Each
    ser5.XValues = xData_Each
    ser5.Name = "Prep"
    ser5.ChartType = xlXYScatterSmooth
    ' 绑定自定义标签
    ser5.ApplyDataLabels Type:=xlDataLabelsShowValue
    For i = 1 To UBound(tData_Each) - LBound(tData_Each) + 1
        ser5.Points(i).DataLabel.Text = tData_Each(LBound(tData_Each) + i - 1)
    Next i
End If

补充说明 #

• 代码兼容0基、1基两种默认下标的数组，不需要额外调整数组定义
• 如需调整标签位置，可在ApplyDataLabels行后添加位置配置，例如ser.DataLabels.Position = xlLabelPositionAbove即可将标签显示在散点上方
• 原代码中ser4绑定yData_Prep数据源但命名为"Each"、ser5绑定yData_Each数据源但命名为"Prep"，存在数据源和名称不匹配问题，可根据实际业务逻辑修正

内容的提问来源于stack exchange，提问作者Miguel Gutiérrez de Antón