VBA：修改图表数据范围

VBA: Modify chart data range

提问by Stuart

My "Chart data range" is ='sheet1'!$A$1:$Z$10. I'd like to make a VBA macro (or if anybody knows a formula I can use, but I couldn't figure one out) to increase the ending column of the range for chart1by 1 every time I run the macro. So essentially:

我的“图表数据范围”是='sheet1'!$A$1:$Z$10. 我想制作一个 VBA 宏（或者如果有人知道我可以使用的公式，但我想不出一个）来在chart1每次运行宏时将范围的结束列增加1。所以本质上：

chart1.endCol = chart1.endCol + 1

chart1.endCol = chart1.endCol + 1

What is the syntax for this using ActiveChartor is there a better way?

这个使用的语法是什么ActiveChart或者有更好的方法？

采纳答案by Netloh

Assuming that you want to expand the range (by adding one extra column) to add one more observation for each series in you diagram (and not to add a new series), you could use this code:

假设您想扩大范围（通过添加一个额外的列）为图表中的每个系列再添加一个观察值（而不是添加新系列），您可以使用以下代码：

Sub ChangeChartRange()
    Dim i As Integer, r As Integer, n As Integer, p1 As Integer, p2 As Integer, p3 As Integer
    Dim rng As Range
    Dim ax As Range

    'Cycles through each series
    For n = 1 To ActiveChart.SeriesCollection.Count Step 1
        r = 0

        'Finds the current range of the series and the axis
        For i = 1 To Len(ActiveChart.SeriesCollection(n).Formula) Step 1
            If Mid(ActiveChart.SeriesCollection(n).Formula, i, 1) = "," Then
                r = r + 1
                If r = 1 Then p1 = i + 1
                If r = 2 Then p2 = i
                If r = 3 Then p3 = i
            End If
        Next i


        'Defines new range
        Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 - p2 - 1))
        Set rng = Range(rng, rng.Offset(0, 1))

        'Sets new range for each series
        ActiveChart.SeriesCollection(n).Values = rng

        'Updates axis
        Set ax = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p1, p2 - p1))
        Set ax = Range(ax, ax.Offset(0, 1))
        ActiveChart.SeriesCollection(n).XValues = ax

    Next n
End Sub

回答by Santosh

Offset functiondynamic range makes it possible.

Offset function动态范围使其成为可能。

Sample data

样本数据

Steps

脚步

• Define a dynamic named range =OFFSET(Sheet1!$A$2,,,1,COUNTA(Sheet1!$A$2:$Z$2))and give it a name mobileRange
• Right Click on Chart
• Click on Select Data

• 定义动态命名范围 =OFFSET(Sheet1!$A$2,,,1,COUNTA(Sheet1!$A$2:$Z$2))并为其命名mobileRange
• 右键单击图表
• 点击选择数据

This screen will come

这个画面会来

Click on Editunder Legend Entries.(mobiles is selected)

单击EditLegend Entries 下的。（已选择移动设备）

• change the Series value to point to mobileRangenamed range.
• Now if data for future months are added to mobile sales it will automatically reflect in chart.

• 将系列值更改为指向mobileRange命名范围。
• 现在，如果将未来几个月的数据添加到移动销售中，它将自动反映在图表中。

回答by PatricK

Assuming that you only run the macro with a Chart Selected, my idea is to alter the range in the formula for each Series. You can of cause change to apply to all Charts in a Worksheet.

假设您只使用选定的图表运行宏，我的想法是更改每个系列的公式范围。您可能会导致更改应用于工作表中的所有图表。

UPDATE: Have changed code to accommodate multiple series with screenshots

更新：已更改代码以适应带有屏幕截图的多个系列

Sub ChartRangeAdd()
    On Error Resume Next
    Dim oCht As Chart, aFormulaOld As Variant, aFormulaNew As Variant
    Dim i As Long, s As Long
    Dim oRng As Range, sTmp As String, sBase As String

    Set oCht = ActiveSheet.ChartObjects(1).Chart
    oCht.Select
    For s = 1 To oCht.SeriesCollection.count
        sTmp = oCht.SeriesCollection(s).Formula
        sBase = Split(sTmp, "(")(0) & "(<FORMULA>)" ' "=SERIES(" & "<FORMULA>)"
        sTmp = Split(sTmp, "(")(1) ' "..., ..., ...)"
        aFormulaOld = Split(Left(sTmp, Len(sTmp) - 1), ",") ' "..., ..., ..."
        aFormulaNew = Array()
        ReDim aFormulaNew(UBound(aFormulaOld))
        ' Process all series in the formula
        For i = 0 To UBound(aFormulaOld)
            Set oRng = Range(aFormulaOld(i))
            ' Attempt to put the value into Range, keep the same if it's not valid Range
            If Err.Number = 0 Then
                Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(0, 1))
                aFormulaNew(i) = oRng.Worksheet.Name & "!" & oRng.Address
            Else
                aFormulaNew(i) = aFormulaOld(i)
                Err.Clear
            End If
        Next i
        sTmp = Replace(sBase, "<FORMULA>", Join(aFormulaNew, ","))
        Debug.Print "Series(" & s & ") from """ & oCht.SeriesCollection(s).Formula & """ to """ & sTmp & """"
        oCht.SeriesCollection(s).Formula = sTmp
        sTmp = ""
    Next s
    Set oCht = Nothing
End Sub

Sample data - Initial

样本数据 - 初始

After first run:

第一次运行后：

Second Run:

第二次运行：

Third Run:

第三次运行：