动态引用VBA中的UsedRange [英] Dynamic referencing the UsedRange in VBA
问题描述
我的代码做了什么：范围，以便它可以绘制值。
Obs1：对于我创建的时间序列中的2个，数据是年化的，因此我向后计算，如果以前的数据少于一年，代码显示为不够数据。
问题：如果我用2个时间序列（2列）运行代码，我在图表中得到两行。但是如果我再删除其中一个系列并再次运行，我将在图表中得到一行值和第二个空行。
问题： / strong>如何解决这个问题？
我已经尝试过：我正在尝试改变引用范围的方式，所以它重新运行代码，它只返回到具有值的行。问题是我找不到正确引用这样的范围的方法。
代码的相关部分：
$ b $函数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
设置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
'没有完整数据的资源
'设置范围
i = 3
如果SourceWorksheet =年度Ret或SourceWorksheet =Annualized Vol然后
尽管w.Worksheets（SourceWorksheet）.Cells（i，2）.Text =N / A
i = i + 1
循环
'#####这是我认为是出现问题的部分：
'#####引用最后一个单元格，从原始列计数中获取列数（范围）。
设置RetRange = w.Worksheets（SourceWorksheet）.Range（w.Worksheets（SourceWorksheet）.Cells（i，1），w.Worksheets（SourceWorksheet）.Cells.SpecialCells（xlLastCell））'* ***************
Else
设置RetRange = w.Sheets（SourceWorksheet）.UsedRange
'Set RetRange = w.Sheets（SourceWorksheet）.Range（A1：& Col_Letter（LastColumn）& LastRow）
End If
'''' '''''''''''''''''''''''''''''''''$'
对于每个chrt RetChart = chrt
RetChart.Activate
p = 1
结束如果
下一个chrt
如果p < 1然后
Set RetChart = Charts.Add
End If
'计算时间序列中的月份数，执行比例
d1 = w.Sheets（ Value（A2）。值
d2 = w.Sheets（SourceWorksheet）.Range（A& LastRow）.Value
numMonth = TestDates（d1，d2 ）
x = Round（（numMonth / 15），1）
'与期间大小的比例
如果x < 3然后
y = 1
ElseIf x> = 3而x < 7然后
y = 4
ElseIf x> 7然后
y = 6
如果
'创建图表
使用RetChart
。选择
.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
'设置修改源的标题名称
如果SourceWorksheet =Drawdown，然后
对于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
下一个lColumn
ElseIf SourceWorksheet =Annualized Ret然后
对于lColumn = 2 To LastColumn
.FullSeriesCollection（lColumn - 1）.Name =='Annualized Ret'！$& Col_Letter（lColumn）& $ 1
下一个lColumn
ElseIf SourceWorksheet =Annualized Vol然后
对于lColumn = 2 To LastColumn
.FullSeriesCollection lColumn - 1）.Name =='Annualized Vol'！$& Col_Letter（lColumn）& $ 1
下一页lColumn
如果
结束
结束函数
Obs2：我的代码目前正在运行（有一些功能我还没有添加，浪费更多空间）
Obs3：当我减少列数（数据系列）时，这是一个问题：
既然我找不到更好，更优雅的方式来解决这个问题（甚至表中出现相同的错误），我通过明确删除最后的额外系列，根据他们的名字进行了更正。
Obs：如果该系列不包含任何数据，则新插入的代码将将该系列名称更改为以下之一，并删除该系列
要添加到最后的代码：
'删除额外的空系列
Dim nS As Series
'这必须被修复。对于永久解决方案，尝试使用表
对于每个nS In RetChart.SeriesCollection
如果nS.Name =Series2或nS.Name =Series3或nS.Name =Series4或nS .Name =Series5或nS.Name =Series6或nS.Name =Series7或nS.Name =Series8或nS.Name =然后
nS.Delete
结束如果
下一个nS
I have a code that gets data from a sheet and creates a graph. In the source sheet, each column is a series, and the number of series may change.
What my code does: it reads the used ranges so that it can graph the values.
Obs1: For 2 of the time series I create, the data is annualized, so as I count backwards for the calculation, if the data before is less than one year, the code shows as "Not Enough Data".
Problem: If I run the code with 2 time series (2 columns), I get two lines in the charts. But if I then delete one of the series and run it again, I get one line with values and a second empty line in the chart.
Question: How can this problem be solved?
What I already tried: I am trying to change the way I reference the ranges, so that it rerun the code, it returns to the graph only lines that have values. Issue is I cannot find a way to properly reference the range like that.
Relevant part of the code:
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: My code is currently functional (there are some functions I haven't added, so as not to waste more space).
Obs3: This is the problem when I decrease the number of columns (data series):
Since I could find no better, more elegant way to approach this problem (even the tables where yielding the same error), I corrected, by explicitly deleting the extra series in the end, based on their names.
Obs: If the Series contained no data, the new inserted code will change that series name to one of the ones below, and delete that series altogether.
Code to be added to the end:
'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
这篇关于动态引用VBA中的UsedRange的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
