Код VBA для изменения / корректировки названий серий нескольких графиков (повторяющиеся заголовки столбцов)

Question

У меня есть VBA, который создает несколько электронных таблиц из электронной таблицы. Каждый график предназначен для различных характеристик c, в которых есть два столбца для расчета 20-го и 80-го процентилей. Поскольку существует несколько столбцов с одинаковыми именами, дубликаты столбцов называются 20th Percentile1, 20th Percentile2 ... et c et c. Как показано ниже:

Из-за этого, после запуска моего графа VBA, я получаю легенды серии, подобные этой: Мне было интересно, был код, который корректирует имя серии, чтобы исключить повторяющиеся числа, поэтому у всех них есть только 20-й и 80-й процентили.

Основная проблема заключается в том, что у меня есть другие серии, такие как «Мин», «Макс, «Предел А» и «Предел Б.» Поэтому я не хочу менять эти серии. Только дубликаты.

Вот мой код:

Sub Graph()

' Creates scatter chart with provided limit/percentile values
'

    Dim my_range    As Range, t

    t = Selection.Cells(1, 1).Value + " - " + ActiveSheet.Name

    Dim OldSheet As Worksheet
    Set OldSheet = ActiveSheet

    Set my_range = Union(Selection, ActiveSheet.Range("A:A"))
    ActiveSheet.Shapes.AddChart2(201, xlLine).Select
    With ActiveChart
        .FullSeriesCollection(1).ChartType = xlLine
        .FullSeriesCollection(1).AxisGroup = 1
        .FullSeriesCollection(2).ChartType = xlLine
        .FullSeriesCollection(2).AxisGroup = 1
        .FullSeriesCollection(1).ChartType = xlXYScatter
        .FullSeriesCollection(1).AxisGroup = 1
        .SetSourceData Source:=my_range
        .HasTitle = True
        .ChartTitle.Text = t
        .Location Where:=xlLocationAsObject, Name:="Graphs"
    End With
    OldSheet.Activate


End Sub

попытался добавить:

    If .FullSeriesCollection(1).Name Like "20th Percentile*" Then
        .FullSeriesCollection(1).Name = "20th Percentile"
    End If

без удачи

Answer 1

Вот более проработанный пример:

Sub Graph()

    Dim my_range As Range, t, co As Shape '<edit

    t = Selection.Cells(1, 1).Value + " - " + ActiveSheet.Name

    Dim OldSheet As Worksheet
    Set OldSheet = ActiveSheet

    Set my_range = Union(Selection, ActiveSheet.Range("A:A"))

    Set co = ActiveSheet.Shapes.AddChart2(201, xlLine) 'add a ChartObject
    With co.Chart
        .FullSeriesCollection(1).ChartType = xlXYScatter
        .FullSeriesCollection(1).AxisGroup = 1
        .FullSeriesCollection(2).ChartType = xlLine
        .FullSeriesCollection(2).AxisGroup = 1
        .SetSourceData Source:=my_range
        .HasTitle = True
        .ChartTitle.Text = t
        ResolveSeriesnames co.Chart 'edit: move this before the .Location line 
        .Location Where:=xlLocationAsObject, Name:="Graphs"
    End With

    OldSheet.Activate
End Sub

'Given a Chart object, loop over its series
'  and check for Names that start with some
'  common root text: if found use the root as the name
Sub ResolveSeriesnames(cht As Chart)
    Dim s As Series, arr, e
    'list of root names to look for
    arr = Array("20th Percentile", "80th Percentile")
    For Each s In cht.SeriesCollection
        For Each e In arr
            If s.Name Like e & "*" Then
                s.Name = e
                Exit For
            End If
        Next e
    Next s
End Sub