VBA: Изменить диапазон данных диаграммы

Question

Мой «Диапазон данных диаграммы» - ='sheet1'!$A$1:$Z$10. Я хотел бы сделать макрос VBA (или, если кто-нибудь знает формулу, которую я могу использовать, но я не мог понять ее), чтобы увеличить конечный столбец диапазона для chart1 на 1 каждый раз, когда я запускаю макрос. Так, по существу:

chart1.endCol = chart1.endCol + 1

Что такое синтаксис для этого с помощью ActiveChart или есть лучший способ?

Answer 1

Предполагая, что вы хотите, чтобы расширить диапазон (добавив один дополнительный столбец), чтобы добавить еще одно наблюдение для каждой серии в вас диаграмме (и не добавлять новую серию), вы можете использовать этот код:

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 2

Offset function динамический диапазон позволяет.

Выборочные данные

Шаги

• Определить динамический именованный диапазон =OFFSET(Sheet1!$A$2,,,1,COUNTA(Sheet1!$A$2:$Z$2)) и дать ему имя mobileRange
• Ri GHT Нажмите на Диаграмме
• Нажмите на Select Data

Этот экран выйдет

Нажмите на Edit под Legend записей. (мобильные выбран)

• измените значение Series на mobileRange именованный диапазон.
• Теперь, если данные о будущих месяцах будут добавлены в продажи мобильных телефонов, они автоматически отразятся на диаграмме.

Answer 3

Предполагая, что вы запускаете макрос только с выбранной диаграммой, моя идея состоит в том, чтобы изменить диапазон в формуле для каждой серии. Вы можете вызвать изменение для всех диаграмм на листе.

UPDATE: Изменились код для размещения нескольких серий со скриншотами

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 

Пример данных - Initial

После первого запуска:

Второй запуск:

Третий Пробег: