VBA: Modify chart data range

后端 未结 4 1200
梦毁少年i
梦毁少年i 2020-11-30 11:54

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 in

相关标签:
4条回答
  • 2020-11-30 12:14

    PatricK's answer works great with some minor adjustments:

    Formatting of new series string needs to include apostrophes around the worksheet name on line 22 aFormulaNew(i) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address. Also, if looking to change rows rather than columns, change the offset on line 21 to Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(1, 0)) or as needed. Can also include oRng.Offset(1, 0) for the first element in the range to adjust the start position of the series: 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
    
    0 讨论(0)
  • 2020-11-30 12:23

    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
    
    0 讨论(0)
  • 2020-11-30 12:29

    Offset function dynamic range makes it possible.

    Sample data

    enter image description here

    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

    This screen will come

    enter image description here

    Click on Edit under Legend Entries.(mobiles is selected)

    enter image description here

    • change the Series value to point to mobileRange named range.
    • Now if data for future months are added to mobile sales it will automatically reflect in chart.
    0 讨论(0)
  • 2020-11-30 12:37

    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

    Formatting of new series string needs to include apostrophes around the worksheet name (already changed below): aFormulaNew(i) = "'" & oRng.Worksheet.Name & "'" & "!" & oRng.Address. Also, if looking to change rows rather than columns, change the offset to Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(1, 0)) or as needed. Can also include oRng.Offset(1, 0) for the first element in the range to adjust the start position of the series: 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
    

    Sample data - Initial

    InitialData

    After first run:

    FirstRun

    Second Run:

    SecondRun

    Third Run:

    ThirdRun

    0 讨论(0)
提交回复
热议问题