Excel气泡图宏未在最后一行停止，额外生成空白系列问题

我有一个生成气泡图的VBA宏，会为动态数据区域的每一行创建新数据系列。手动验证最后一行计算准确，但宏仍会在最后一行之后添加10个空白通用数据系列。

原宏代码 #

Sub bubble()
'
' bubble Macro for bubble chart
'

Dim Lastrow As Long, ws As Worksheet, wsRD As Worksheet, wsChart As Worksheet
Dim cht As ChartObject, currRow As Integer
Dim ch As Shape, SeriesNum As Integer
   
On Error GoTo ExitSub
For Each ws In ActiveWorkbook.Sheets
    If Left(ws.Name, 12) = "Raw Data SEA" Then
        Set wsRD = ws
    End If
    If Left(ws.Name, 10) = "SEA bubble" Then
        Set wsChart = ws
    End If
Next ws

Lastrow = wsRD.Cells(Rows.Count, 1).End(xlUp).Row

  

Set ch = wsChart.Shapes(1)
ch.Name = "SEACht"

SeriesNum = 1
For currRow = 2 To Lastrow
    ch.Chart.SeriesCollection.NewSeries
    
    ch.Chart.FullSeriesCollection(SeriesNum).Name = wsRD.Cells(currRow, 1)
    ch.Chart.FullSeriesCollection(SeriesNum).XValues = wsRD.Cells(currRow, 2)
    ch.Chart.FullSeriesCollection(SeriesNum).Values = wsRD.Cells(currRow, 4)
    ch.Chart.FullSeriesCollection(SeriesNum).BubbleSizes = wsRD.Cells(currRow, 3)
    SeriesNum = SeriesNum + 1
Next currRow
    
'Format Legend

    ch.Chart.PlotArea.Select
    ch.Chart.SetElement (msoElementLegendBottom)
    ActiveWorkbook.Save

'Format X and Y axes

    
    ch.Chart.Axes(xlCategory).Select
    ch.Chart.Axes(xlCategory).MinimumScale = 0
    ch.Chart.ChartArea.Select
    ch.Chart.Axes(xlValue).Select
    ch.Chart.Axes(xlValue).MinimumScale = 0
    Application.CommandBars("Format Object").Visible = False
    ActiveWorkbook.Save
    
    
' Format datalabels


    ch.Chart.ApplyDataLabels
    ch.Chart.FullSeriesCollection(1).DataLabels.Select
    ch.Chart.FullSeriesCollection(1).HasLeaderLines = False
    Application.CommandBars("Format Object").Visible = False
    ActiveWorkbook.Save

' Add charttitle
'

    ch.Chart.SetElement (msoElementChartTitleAboveChart)
    ch.Chart.Paste
    ch.Chart.ChartTitle.Text = _
        "Properties operating exp - RSF and Building Age Factors"
    ActiveWorkbook.Save

ExitSub:
End Sub

问题原因 #

Excel默认创建的气泡图会自带多个空白数据系列（通常为10个），宏运行时未先清除这些原有系列，直接添加新数据系列后，原有空白系列仍保留，最终出现多余的空白通用数据系列。

修改方案 #

在添加新系列前，先循环删除图表中所有已有的数据系列，同时移除不必要的Select语句提升代码稳定性：

修改后的代码 #

Sub bubble()
'
' bubble Macro for bubble chart
'

Dim Lastrow As Long, ws As Worksheet, wsRD As Worksheet, wsChart As Worksheet
Dim currRow As Integer
Dim ch As Shape, SeriesNum As Integer
Dim i As Integer ' 新增变量用于删除系列
   
On Error GoTo ExitSub
For Each ws In ActiveWorkbook.Sheets
    If Left(ws.Name, 12) = "Raw Data SEA" Then
        Set wsRD = ws
    End If
    If Left(ws.Name, 10) = "SEA bubble" Then
        Set wsChart = ws
    End If
Next ws

Lastrow = wsRD.Cells(Rows.Count, 1).End(xlUp).Row

Set ch = wsChart.Shapes(1)
ch.Name = "SEACht"

' 清除图表中所有已有数据系列（倒序删除避免索引混乱）
With ch.Chart
    For i = .SeriesCollection.Count To 1 Step -1
        .SeriesCollection(i).Delete
    Next i
End With

SeriesNum = 1
For currRow = 2 To Lastrow
    ch.Chart.SeriesCollection.NewSeries
    
    ch.Chart.FullSeriesCollection(SeriesNum).Name = wsRD.Cells(currRow, 1)
    ch.Chart.FullSeriesCollection(SeriesNum).XValues = wsRD.Cells(currRow, 2)
    ch.Chart.FullSeriesCollection(SeriesNum).Values = wsRD.Cells(currRow, 4)
    ch.Chart.FullSeriesCollection(SeriesNum).BubbleSizes = wsRD.Cells(currRow, 3)
    SeriesNum = SeriesNum + 1
Next currRow
    
'Format Legend
ch.Chart.SetElement (msoElementLegendBottom)
ActiveWorkbook.Save

'Format X and Y axes
ch.Chart.Axes(xlCategory).MinimumScale = 0
ch.Chart.Axes(xlValue).MinimumScale = 0
Application.CommandBars("Format Object").Visible = False
ActiveWorkbook.Save
    
' Format datalabels
ch.Chart.ApplyDataLabels
ch.Chart.FullSeriesCollection(1).HasLeaderLines = False
Application.CommandBars("Format Object").Visible = False
ActiveWorkbook.Save

' Add charttitle
ch.Chart.SetElement (msoElementChartTitleAboveChart)
ch.Chart.ChartTitle.Text = _
    "Properties operating exp - RSF and Building Age Factors"
ActiveWorkbook.Save

ExitSub:
End Sub

内容的提问来源于stack exchange，提问作者blhdev