Динамическая ссылка на 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