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

Question

Я хочу изменить код в this answer, чтобы вместо увеличения диапазона на единицу оно уменьшало диапазон на единицу. Есть идеи, как это сделать?

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 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 = rng.Resize(rng.Rows.Count, rng.Columns.Count - 1) '~~> Replaced line 

     '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 = ax.Resize(ax.Rows.Count, ax.Columns.Count - 1)  '~~> Replaced line 
     ActiveChart.SeriesCollection(n).XValues = ax 

    Next n 
End Sub 

Answer 2

Я думаю, что вам нужно сделать, это изменить

Set rng = Range(rng, rng.Offset(0, 1))

в

Set rng = Range(rng, rng.Offset(0, -1)).

EDIT: Попробуйте изменить это уравнение вокруг

Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 - p2 - 1))

Например, вы могли бы попробовать:

Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 - 1, p3 - p2 - 1))

или

Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 + p2 - 1))

или

Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 - p2 + 1))

И так далее так далее ...

Answer 3

Вы можете использовать бесплатную надстройку на моем сайте, чтобы настроить формулу диаграммы серии. Он работает как Find-Replace. Прочитайте последнюю строку данных из формулы ряда, это значение из-за значения, вычтите значение, чтобы получить значение изменения. Учебник - Change Series Formula – Improved Routines, и он начинается с некоторого кода VBA, если вы хотите попробовать его самостоятельно, но ближе к концу это ссылка на надстройку «Change Series Formula».