动态引用VBA中的UsedRange

时间:2017-02-20 09:22:17

标签: excel vba excel-vba charts range

我有一个从工作表中获取数据并创建图表的代码。在源表中,每列都是一个系列,并且系列的数量可能会更改。

我的代码执行的操作:它会读取已使用的范围,以便它可以绘制值。

Obs1:对于我创建的2个时间序列,数据是年度化的,因此我向后计算计算,如果之前的数据少于一年,则代码显示为“没有足够的数据“。

问题:如果我运行2个时间序列(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:当我减少列数(数据系列)时出现问题:enter image description here

1 个答案:

答案 0 :(得分:0)

由于我找不到更好,更优雅的方法来解决这个问题(即使是产生相同错误的表格),我通过根据名称明确删除最后的额外系列来纠正。

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