使用VBA遍历工作表所有图表，扩展Data Range至新增一行

要实现给所有图表的每个数据系列都新增一行数据，核心是操作每个图表的Series对象的Values属性（即数据范围）。无需激活图表即可完成操作，代码运行更高效。

修改后的完整代码如下：

Sub LoopThroughCharts()
    Dim sht As Worksheet
    Dim CurrentSheet As Worksheet
    Dim cht As ChartObject
    Dim srs As Series
    Dim originalRange As Range
    Dim newRange As Range
  
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set CurrentSheet = ActiveSheet

    '遍历工作簿中所有工作表
    For Each sht In ActiveWorkbook.Worksheets
        '遍历当前工作表的所有嵌入式图表
        For Each cht In sht.ChartObjects
            '遍历图表中的每个数据系列
            For Each srs In cht.Chart.SeriesCollection
                '获取当前系列的原始数据范围
                Set originalRange = srs.Values
                
                '计算新的数据范围：起始单元格不变，结束行号+1
                Set newRange = sht.Range(originalRange.Cells(1), _
                    sht.Cells(originalRange.Row + originalRange.Rows.Count, originalRange.Column + originalRange.Columns.Count - 1))
                
                '为系列设置新的数据范围
                srs.Values = newRange
            Next srs
        Next cht
    Next sht

    CurrentSheet.Activate
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

代码说明： #

• 移除了不必要的cht.Activate，直接通过对象模型操作图表，避免界面闪烁
• 遍历每个图表的SeriesCollection（所有数据系列），确保不管图表包含多少个系列都能处理
• 通过originalRange.Rows.Count获取原数据范围的行数，将结束行号加1生成新范围
• 兼容单列、多列的数据范围，比如原范围是J43:K144，会自动扩展为J43:K145

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