2017-02-20 131 views
1

我有一個代碼可以從工作表中獲取數據並創建一個圖形。在源表中,每列都是一系列,並且系列的數量可能會發生變化。在VBA中動態引用UsedRange

我的代碼的作用:它讀取使用的範圍,以便它可以繪製值。

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

+0

您是否嘗試過將你的數據轉換成一個表,然後隨着數據變化曲線圖會自動調整? – SJR

+0

@SJR不,我沒有。謹慎舉例說明如何做到這一點? – DGMS89

+1

@ DGMS89:https://support.office.com/en-us/article/Overview-of-Excel-tables-7ab0bb7d-3a9e-4b56-a3c9-6c94334e492c這應該解釋很多,簡而言之,Excel表格是智能對象(VBA中的'ListObjects'),如果您在表格後面的下一個可用行中添加數據,這些對象將會擴展,因此應該幫助解決您的問題! ;) – R3uK

回答

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