VBA hinzufügen Series Überlappungen Daten

Question

Excel 2013, 10 Win

ich zwei Pivot-Tabellen habe ich versuche, auf einem Diagramm angezeigt werden soll. (Ich kann nicht auf die Quelldaten kombinieren, weil es zu viele Zeilen ist.) Also habe ich beschlossen, die Serie zu einem Diagramm in VBA hinzuzufügen:

Sub createProductionChart() 
    Sheets("ProductionChart").Select 
    ActiveSheet.ChartObjects("Chart 2").Activate 
    ActiveChart.ChartArea.Select 
    For Each s In ActiveChart.SeriesCollection 
     s.Delete 
    Next s 

    ActiveChart.ChartType = xlAreaStacked 

    'Add history 
    For i = 2 To 41 
     If IsEmpty(Worksheets("History Pivot").Cells(6, i)) Then 
      Exit For 
     End If 


     Set tSeries = ActiveChart.SeriesCollection.NewSeries 
     tSeries.XValues = Worksheets("History Pivot").Range("$A$7:$A$300") 
     tSeries.Values = Worksheets("History Pivot").Range(Cells(7, i).Address, Cells(300, i).Address) 
     tSeries.Name = Worksheets("History Pivot").Cells(6, i).Value 
    Next i 
    ' add forecast: 
    For j = 2 To 200 
     If IsEmpty(Worksheets("Forecast Pivot").Cells(7, j)) Then 
      Exit For 
     End If 
     Set tSeries = ActiveChart.SeriesCollection.NewSeries 
     tSeries.XValues = Worksheets("Forecast Pivot").Range("$A$8:$A$300") 
     tSeries.Values = Worksheets("Forecast Pivot").Range(Cells(8, j).Address, Cells(300, j).Address) 
     If IsEmpty(Worksheets("Forecast Pivot").Cells(6, j)) Then 
      yr = Worksheets("Forecast Pivot").Cells(6, j - 1).Value 
     Else 
      yr = Worksheets("Forecast Pivot").Cells(6, j).Value 
     End If 
     tSeries.Name = yr & " " & Worksheets("Forecast Pivot").Cells(7, j).Value 
    Next j 



End Sub 

Die Quelldaten Serie disjunkt sind in X (sie Daten sind, und Die beiden Diagramme stellen, wie genannt, History- und Forecast-Daten dar.
XL häuft sie nur auf der jeweils anderen:

Die „Prognose“ Daten auf der rechten Seite der Geschichte sein sollte.

Wie gewünscht, Probe der Quelldaten - sie sind riesig, so dass nur die obere linke Ecke wird angezeigt: Geschichte:

Prognose: Irgendwelche Ideen?

Answer 1

Der Grund für die Prognose auf der Oberseite der Geschichte sitzt, weil die gestapeltes Flächendiagramm immer es die Daten basierend auf der Reihenfolge der Daten (auch wenn die Werte Ihrer Reichweite sind in der Zukunft) ausrichten .

Sie müssen alle Daten in Ihrem Verlauf auch zu Ihren Vorhersagewerten hinzufügen (und es ist, als ob sie einen Wert von 0 haben).

Ich bin mir nicht sicher, ob mir klar ist, lassen Sie mich wissen, wenn Sie weitere Erläuterungen benötigen.

Wie auch immer, versuchen Sie den Code unten, es mit dem Test war ich auf meiner Arbeitsmappe tat und Grafik:

Sub createProductionChart() 

Dim Rng_Hisotry   As Range 
Dim Rng_Forecast  As Range 
Dim Rng_Combined  As Range 

Sheets("ProductionChart").Select 
ActiveSheet.ChartObjects("Chart 2").Activate 
ActiveChart.ChartArea.Select 

For Each s In ActiveChart.SeriesCollection 
    s.Delete 
Next s 

ActiveChart.ChartType = xlAreaStacked 

Set Rng_Hisotry = Worksheets("Forecast Pivot").Range("$A$8:$A$300") 
Set Rng_Forecast = Worksheets("Forecast Pivot").Range("$A$8:$A$300") 

' add History with Forecast Range >> so the forecast data will start 
' from the correct position on the chart 
Set Rng_Combined = Range(Rng_Hisotry.Address & ":" & Rng_Forecast.Address) 

' Add History 
For i = 2 To 41 
    If IsEmpty(Worksheets("History Pivot").Cells(6, i)) Then 
     Exit For 
    End If 

    Set tSeries = ActiveChart.SeriesCollection.NewSeries 
    tSeries.XValues = Rng_Hisotry 
    tSeries.Values = Worksheets("History Pivot").Range(Cells(7, i).Address, Cells(300, i).Address) 
    tSeries.Name = Worksheets("History Pivot").Cells(6, i).Value 
Next i 

' Add Forecast 
For j = 2 To 200 
    If IsEmpty(Worksheets("Forecast Pivot").Cells(7, j)) Then 
     Exit For 
    End If 

    Set tSeries = ActiveChart.SeriesCollection.NewSeries 

    tSeries.XValues = Rng_Combined 
    tSeries.Values = Worksheets("Forecast Pivot").Range(Cells(8, j).Address, Cells(300, j).Address) 

    If IsEmpty(Worksheets("Forecast Pivot").Cells(6, j)) Then 
     yr = Worksheets("Forecast Pivot").Cells(6, j - 1).Value 
    Else 
     yr = Worksheets("Forecast Pivot").Cells(6, j).Value 
    End If 
    tSeries.Name = yr & " " & Worksheets("Forecast Pivot").Cells(7, j).Value 
Next j 

End Sub