Dynamische Referenzierung des UsedRange in VBA

Question

Ich habe einen Code, der Daten von einem Blatt erhält und ein Diagramm erstellt. Im Quellblatt ist jede Spalte eine Serie und die Anzahl der Serien kann sich ändern.

Was mein Code tut: liest die verwendeten Bereiche, so dass es die Werte grafisch darstellen kann.

Obs1: für 2 der Zeitreihe I erstellen, wird die Daten auf Jahresbasis, so wie ich rückwärts zähle für die Berechnung, wenn die Daten vor weniger als ein Jahr ist, zeigt der Code als „Nicht genügend Daten“ .

Problem: Wenn ich den Code mit 2 Zeitreihen (2 Spalten) ausführen, bekomme ich zwei Zeilen in den Diagrammen. Aber wenn ich dann eine der Serien lösche und sie erneut laufe, bekomme ich eine Zeile mit Werten und eine zweite leere Zeile im Diagramm.

Frage: Wie kann dieses Problem gelöst werden?

Was ich schon versucht habe: Ich versuche, die Art, wie ich die Bereiche referenzieren, zu ändern, so dass es den Code erneut ausführt, es gibt nur Linien zurück, die Werte haben. Problem ist, dass ich keinen Weg finden kann, den Bereich korrekt zu referenzieren.

Relevante Teil des Codes:

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: Mein Code zur Zeit funktionsfähig ist (es gibt einige Funktionen, die ich habe nicht hinzugefügt, um nicht mehr Platz zu verschwenden).

Obs3: Das ist das Problem, wenn ich die Anzahl der Spalten (Datenreihe) verringern:

Answer 1

Da ich nicht besser, eleganten Weg, um dieses Problem zu nähern (auch die Tische, an denen wodurch man finden konnte, die der gleiche Fehler), korrigierte ich, indem ich die Extra-Serie am Ende basierend auf ihren Namen explizit löschte.

Obs: Wenn die Serie keine Daten enthält, ändert der neu eingefügte Code den Seriennamen in einen der folgenden und löscht diese Serie vollständig.

-Code bis zum Ende hinzugefügt werden:

'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