excel - VBA：修改图表数据范围

Question

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

chart1.endCol = chart1.endCol + 1

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

Answer 1

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

样本数据

脚步

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

会出现这个画面

Edit在 Legend Entries 下单击。（已选择移动设备）

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

Answer 2

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

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

Answer 3

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

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

新系列字符串的格式需要在工作表名称周围包含撇号（已在下面更改）aFormulaNew(i) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address：. 此外，如果要更改行而不是列，请将偏移量更改为Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(1, 0))或 根据需要。还可以包括oRng.Offset(1, 0)为范围中的第一个元素调整系列的开始位置：Set oRng = oRng.Worksheet.Range(oRng.Offset(1, 0), oRng.Offset(1, 0))

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

样本数据 - 初始

第一次运行后：

第二轮：

第三轮：

Answer 4

帕特里克的回答通过一些小的调整效果很好：

新系列字符串的格式需要在第 22 行的工作表名称周围包含撇号 aFormulaNew(i) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address。此外，如果要更改行而不是列，请将第 21 行的偏移量更改为Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(1, 0))或根据需要更改。还可以包括oRng.Offset(1, 0)为范围中的第一个元素调整系列的开始位置：Set oRng = oRng.Worksheet.Range(oRng.Offset(1, 0), oRng.Offset(1, 0))

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

Answer 5

帕特里克和西尔贝德维尔让我很好地开始了这一点。现在，我正在尝试将其合并到一个单独的子中，我可以引用它来处理多个图表。不幸的是，我在引用中遗漏了一些东西，所以它没有进行更新（也没有产生错误）。

第一子使用第二子

If ws < numTabs - 1 Then
    chartUpdate Summary, Chart_BidsByMonth ' Name of sheet with target chart, Name of target chart
    chartUpdate Summary, Chart_SoldByMonth ' Name of sheet with target chart, Name of target chart
End If

第二次子处理图表范围更新

Sub chartUpdate(shtRef As Variant, chtRef As Variant)
    On Error Resume Next
    Dim oCht As Chart, aFormulaOld As Variant, aFormulaNew As Variant
    Dim n As Long, s As Long
    Dim oRng As Range, sTmp As String, sBase As String

        ' Update chart referenced as chtRef '
        Set oCht = Sheets(""" & shtRef & """).ChartObjects(""" & chtRef """).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 n = 0 To UBound(aFormulaOld)
                Set oRng = Range(aFormulaOld(n))
                ' 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(n) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address
                Else
                    aFormulaNew(n) = aFormulaOld(i)
                    Err.Clear
                End If
            Next n
            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 charts update '
    End Sub