Динамическая ссылка на UsedRange в VBA

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

Что делает мой код: он читает используемые диапазоны, чтобы он мог отобразить значения.

Obs1: для двух временных рядов, которые я создаю, данные делятся на год, так что я рассчитываю назад для расчета, если данные до этого были менее одного года, код отображается как "Недостаточно данных".

Проблема: если я запускаю код с двумя временными рядами (2 столбца), я получаю две строки в диаграммах. Но если я затем удаляю одну серию и запускаю ее снова, я получаю одну строку со значениями и вторую пустую строку на графике.

Вопрос: Как решить эту проблему?

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

Соответствующая часть кода:

Function Grapher(ChartSheetName As String, SourceWorksheet As String, ChartTitle As String, secAxisTitle As String)

Dim lColumn As Long, lRow As Long
Dim LastColumn As Long, LastRow As Long
Dim RetChart As Chart
Dim w As Workbook
Dim RetRange As Range
Dim chrt As Chart
Dim p As Integer
Dim x As Long, y As Long
Dim numMonth As Long
Dim d1 As Date, d2 As Date
Dim i As Long

Set w = ThisWorkbook

'find limit
LastColumn = w.Sheets(SourceWorksheet).Cells(1,   w.Sheets(SourceWorksheet).Columns.Count).End(xlToLeft).column
LastRow = w.Sheets(SourceWorksheet).Cells(w.Sheets(SourceWorksheet).Rows.Count, "A").End(xlUp).Row

'check for sources that do not have full data
'sets the range
i = 3
If SourceWorksheet = "Annualized Ret" Or SourceWorksheet = "Annualized Vol" Then

    Do While w.Worksheets(SourceWorksheet).Cells(i, 2).Text = "N/A"

        i = i + 1

    Loop

'##### this is the part I believe is giving the problem:
    '##### the way to reference the last cell keeps getting the number of columns (for the range) from the original column count. 

    Set RetRange =    w.Worksheets(SourceWorksheet).Range(w.Worksheets(SourceWorksheet).Cells(i, 1), w.Worksheets(SourceWorksheet).Cells.SpecialCells(xlLastCell)) '****************

Else

    Set RetRange = w.Sheets(SourceWorksheet).UsedRange

    'Set RetRange = w.Sheets(SourceWorksheet).Range("A1:" &   Col_Letter(LastColumn) & LastRow)

End If

'''''''''''''''''''''''

For Each chrt In w.Charts
    If chrt.Name = ChartSheetName Then
        Set RetChart = chrt
        RetChart.Activate
        p = 1
    End If
Next chrt

If p <> 1 Then
    Set RetChart = Charts.Add
End If

'count the number of months in the time series, do the ratio
d1 = w.Sheets(SourceWorksheet).Range("A2").Value
d2 = w.Sheets(SourceWorksheet).Range("A" & LastRow).Value

numMonth = TestDates(d1, d2)

x = Round((numMonth / 15), 1)

'ratio to account for period size
If x < 3 Then
    y = 1
ElseIf x >= 3 And x < 7 Then
    y = 4
ElseIf x > 7 Then
    y = 6
End If

'create chart
        With RetChart
            .Select
            .ChartType = xlLine
            .HasTitle = True
            .ChartTitle.Text = ChartTitle
            .SetSourceData Source:=RetRange
            .Axes(xlValue).MaximumScaleIsAuto = True
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text =  secAxisTitle
            .Name = ChartSheetName
            .SetElement (msoElementLegendBottom)
            .Axes(xlCategory).TickLabelPosition = xlLow
            .Axes(xlCategory).MajorUnit = y
            .Axes(xlCategory).MajorUnitScale = xlMonths

'sets header names for modified sources
            If SourceWorksheet = "Drawdown" Then
                For lColumn = 2 To LastColumn

                    .FullSeriesCollection(lColumn - 1).Name = "=DD!$" & Col_Letter(lColumn) & "$1"
                    .FullSeriesCollection(lColumn - 1).Values = "=DD!$" & Col_Letter(lColumn) & "$3:$" & Col_Letter(lColumn) & "$" & LastRow

                Next lColumn

            ElseIf SourceWorksheet = "Annualized Ret" Then
                For lColumn = 2 To LastColumn

                    .FullSeriesCollection(lColumn - 1).Name = "='Annualized Ret'!$" & Col_Letter(lColumn) & "$1"

                Next lColumn

            ElseIf SourceWorksheet = "Annualized Vol" Then
                For lColumn = 2 To LastColumn

                    .FullSeriesCollection(lColumn - 1).Name = "='Annualized Vol'!$" & Col_Letter(lColumn) & "$1"

                Next lColumn

            End If

        End With

End Function

Obs2: мой код в настоящее время функционален (есть некоторые функции, которые я не добавил, чтобы не тратить больше места).

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

1 ответ

Решение

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

Obs: если серия не содержит данных, новый вставленный код изменит название этой серии на одну из приведенных ниже, и удалит эту серию полностью.

Код для добавления в конец:

'deleting the extra empty series
        Dim nS As Series
        'this has to be fixed. For a permanent solution, try to use tables
        For Each nS In RetChart.SeriesCollection
            If nS.Name = "Series2" Or nS.Name = "Series3" Or nS.Name = "Series4" Or nS.Name = "Series5" Or nS.Name = "Series6" Or nS.Name = "Series7" Or nS.Name = "Series8" Or nS.Name = "" Then
                nS.Delete
            End If
        Next nS
Другие вопросы по тегам