Динамический заголовок у диаграммы excel

Question

Динамический заголовок у диаграммы excel

Рейтинг: 0Ответов: 1Опубликовано: 04.03.2023

Приходится строить много диаграмм. К примеру, графиков ratio (соотношений двух биржевых активов) по каждому дню отдельно. В принципе, все довольно быстро: выделила 2 столбца (1-й дата и время, 2-й цена ratio), нажала F11 и на отдельном листе сформировалась нужная диаграмма. В ней приходится вручную менять заголовок, причем диаграмм много, а заголовки однотипные, состоят из слова ratio и дня, за который это соотношение построено:

Диаграмм очень много, более полутысячи. Можно ли как-то автоматизировать этот процесс, чтобы название диаграммы формировалось автоматически, и если возможно, название листа?

excel диаграммы

Источник: Stack Overflow на русском

Answer 1

▲ 1Принят

Комментарии в коде.

Sub make_charts()
    Dim ws As Worksheet, tbl As ListObject, cl As Range, rng As Range
    
    Set ws = ThisWorkbook.Sheets("ratio")
    Set tbl = ws.ListObjects("Таблица3")
    
    Application.ScreenUpdating = False

    ' сортируем таблицу с данными по дате
    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=tbl.ListColumns(1).DataBodyRange, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    tbl.AutoFilter.ShowAllData ' очищаем фильтры таблицы
       
    ' формируем коллекцию (множество) дат, имеющихся в таблице
    Dim col As New Collection
    On Error Resume Next
    For Each cl In tbl.ListColumns(1).DataBodyRange
        d = cl.Value
        col.Add d, CStr(d)
    Next
    On Error GoTo 0
    
    Dim ch As Chart
    
    ' перебираем все даты, по каждой из дат строим отдельную диаграмму
    For Each d In col
        tbl.Range.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, Replace(Format(d, "m/d/yyyy"), ".", "/"))
        Set rng = tbl.ListColumns(11).DataBodyRange.SpecialCells(xlCellTypeVisible)
        
        ' предварительно удаляем лист диаграммы с такой датой, если он существует
        Application.DisplayAlerts = False
        On Error Resume Next
        ThisWorkbook.Sheets(CStr(d)).Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        
        ' создаем диаграмму на отдельном листе и переносим его после всех листов
        Set ch = ThisWorkbook.Charts.Add2
        ch.Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        
        With ch
            .Name = CStr(d) ' задаем имя листа с диаграммой
            .ChartType = xlLine ' задаем тип диаграммы (график)
            .ChartTitle.Caption = "График на дату: " & CStr(d) ' задаем заголовок диаграммы
            .SetSourceData rng ' задаем источник данных
            
           ' оформляем ось Х
            
            .Axes(xlCategory).TickLabelPosition = xlLow
            .Axes(xlCategory).CategoryType = xlTimeScale
            .FullSeriesCollection(1).XValues = "=" & rng.Parent.Name & "!" & rng.Offset(, -1).Address
            .FullSeriesCollection(1).Name = "=""Дата/время"""
            .Axes(xlCategory).CategoryType = xlCategoryScale
            .Axes(xlCategory).TickLabels.NumberFormat = "dd.mm.yy hm:mm;@"
                                    
            ' применяем стиль диаграммы
            .ChartStyle = 233
        End With
    Next
    
    tbl.AutoFilter.ShowAllData
    Application.ScreenUpdating = True
End Sub

Динамический заголовок у диаграммы excel

Ответы