Динамический график с VBA

Question

Я пишу макрос Excel, который создает диаграммы с динамическими диапазонами (т. Е. Автоматически обновляется при добавлении новой строки данных - https://trumpexcel.com/wp-content/uploads/2017/08/Dynamic-Chart-Range-in-Excel-Demo.gif).. Для примера, который я тестирую, мои данные находятся в столбцах Aи B.

Я знаю, что это можно сделать с помощью таблиц или определенных диапазонов, но, к сожалению, ни один из них не работает для этого конкретного проекта.

Код, который я сейчас использую (два разныхверсии) прекрасно создайте график, и я не буду явно определять диапазон. Однако, когда я добавляю новую строку данных, графики не обновляются.

Sub AddGraphs()
    'Set the dynamic ranges
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    LC = Cells(1, Columns.Count).End(xlToLeft).Column

    'Create the chart
    Charts.Add
    With ActiveChart
        .ChartType = xlColumnClustered
        .SetSourceData Source:=Range(Cells(1, 1), Cells(lr, LC))
        .Location xlLocationAsObject, "Sheet1"
    End With

    'Format chart and set location
    With ActiveChart
        .Parent.Top = Cells(1, LC + 3).Top
        .Parent.Left = Cells(1, LC + 3).Left
        .HasLegend = False
    End With
End Sub

'Alternative code

Sub Test()
    Dim LastRow As Long
    Dim Rng1 As Range
    Dim rng2 As Range
    Dim ShName As String
    With ActiveSheet
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Rng1 = .Range("A2:A" & LastRow & ", B2:B" & LastRow)
        ShName = .Name
    End With
    Charts.Add
    With ActiveChart
        .ChartType = xlLine
        .SetSourceData Source:=Rng1

        .Location Where:=xlLocationAsObject, Name:=ShName
    End With
End Sub

Answer 1

Я использовал Shapes для создания диаграммы только на вашем активном листе, а не для создания диаграммы.

Option Explicit

Sub AddGraphs()
    Dim lr As Long, lc As Long, ch As ChartObject
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    ActiveSheet.Shapes.AddChart.Name = "Cat" '<--- Used Shapes to keep this on the sheet only
    ActiveSheet.ChartObjects("Cat").Select '<--- Naming the Chart to later call and use in Change_Event
    With ActiveChart
        .ChartType = xlColumnClustered
        .SetSourceData Source:=Range(Cells(1, 1), Cells(lr, lc))
        .Location xlLocationAsObject, "Sheet1"
        .Parent.Top = Cells(1, lc + 3).Top
        .Parent.Left = Cells(1, lc + 3).Left
        .HasLegend = False
    End With
End Sub

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

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Cells(Rows.Count, 2).End(xlUp).Row = Cells(Rows.Count, 1).End(xlUp).Row Then Exit Sub
    ChartObjects("Cat").Select '<--- Using named shape/chart
    With ActiveChart
        Dim lr As Long, lc As Long
        lr = Cells(Rows.Count, 1).End(xlUp).Row
        lc = Cells(1, Columns.Count).End(xlToLeft).Column
        .SetSourceData Source:=Range(Cells(1, 1), Cells(lr, lc))
    End With
End Sub

---

Edit2: Повторный пост, чтобы исправить пару других вещей, чтобы сделать эту работу.

Answer 2

Спасибо @Cyril за идею!

Код теперь обновляется следующим образом:

Option Explicit 'Excel worksheet change event Range A1 to B50
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:B50")) Is Nothing Then
            'Set the dynamic ranges

        Dim lr As Integer
        Dim lc As Integer

        lr = Cells(Rows.Count, 1).End(xlUp).Row
        lc = Cells(1, Columns.Count).End(xlToLeft).Column

    'Create the chart
        Charts.Add
        With ActiveChart
            .ChartType = xlColumnClustered
            .SetSourceData Source:=Range(Cells(1, 1), Cells(lr, lc))
            .Location xlLocationAsObject, "Sheet1"
        End With

    'Format chart and set location
        With ActiveChart
            .Parent.Top = Cells(1, lc + 3).Top
            .Parent.Left = Cells(1, lc + 3).Left
            .HasLegend = False
        End With
    End If
End Sub

Это прекрасно работает, за исключением того, что он создает новую диаграмму при каждом запуске макроса, иЯ хотел бы обновить существующий график - буду признателен за любую помощь!