VBA Diagramm gestapelte Säulen mit 2 Achsen
25.08.2023 18:29:34
Beverly
Hi Kevin,
die Datenreihen der Sekundärachse werden standardmäßig niemals an die Datenreihen der Primärachse "hinten angestellt" sondern stets an dieselbe Position, bzw. in dieselbe Rubrik. Sie liegen aber immer vor denen der Primärachse, d.h. sie verdecken diese Säulen wenn sie gleich groß oder größer sind.
Deshalb muss man zusätzliche Dummy-Datenreihen verwenden, die die Säulen entsprechend innerhalb der Rubriken verschieden. Auf der Primärachse benötigt man 1 zusätzliche Dummy-Datenreihe, damit diese die anderen beiden Säulen nach links verschiebt. Dasselbe Prinzip trifft auf die Säulen der Sekundärachse zu, nur muss man die Dummy-Datenreihe(n) dort der eigentlichen Datenreihe voranstellen, damit diese nach rechts verschoben wird. Auf der Sekundärachse sind es außerdem 2 Dummy-Datenreihen, da ja 1 Säule (Datenreihe) angezeigt werden soll. Das Diagramm muss also (in diesem Fall) dieselbe Anzahl an Datenreihen auf beiden Achsen haben, d.h. es muss aus 3 Datenreihen auf der Primär- und 3 Datenreihen auf der Sekundärachse bestehen, wobei die Säulen auf der Sekundärachse "normalerweise" die Säulen auf der Primärachse direkt verdecken würden - da die beiden ersten Datenreihen aber keine Werte haben, werden sie Säulen nicht dargestellt und nur die 3. Säule mit den gewünschten Werten ist sichtbar.
Natürlich muss man am Ende dann noch die überflüssigen Legendeneinträge löschen.
Sub CreateColumnChartWithSecondaryAxis()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Tabelle1") ' Arbeitsblattnamen anpassen
Dim chart As ChartObject
Set chart = ws.ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225)
With chart.chart
.ChartType = xlColumnClustered
' X-Achse benennen
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "Nummerierung"
' Primre Y-Achse formatieren
With .Axes(xlValue)
.HasTitle = True
.AxisTitle.Text = "Euro [Û]"
End With
'Datenreihe 1
With .SeriesCollection.NewSeries
.Name = "Anfangsinvest"
.Values = ws.Range("B2:D2")
End With
'Datenreihe 2
With .SeriesCollection.NewSeries
.Name = "Jhrliche Kosten"
.Values = ws.Range("B3:D3")
End With
' eine zusätzliche Datenreihe erstellen um die andere beiden nach links zu verschieben
.SeriesCollection.NewSeries
Dim intZaehler As Integer
' 3 neue Datenreihen auf der Sekundärachse erstellen
For intZaehler = 1 To 3
With .SeriesCollection.NewSeries
.AxisGroup = xlSecondary
End With
Next intZaehler
' der letzten Datenreihe Name, Werte und Farbe Grau zuweisen, da diese Säule angezeigt werden soll
With .SeriesCollection(.SeriesCollection.Count)
.Name = "Amortisationszeit"
.Values = ws.Range("B4:D4")
.Interior.Color = 10921638
End With
' überflüssige Legenden-Einträge löschen
For intZaehler = .SeriesCollection.Count To 1 Step -1
Select Case .SeriesCollection(intZaehler).Name
Case "Amortisationszeit", "Jhrliche Kosten", "Anfangsinvest"
Case Else
.Legend.LegendEntries(intZaehler).Delete
End Select
Next intZaehler
' 2. Y-Achse bennen
With .Axes(xlValue, xlSecondary)
.HasTitle = True
.AxisTitle.Text = "Amortisationszeit"
End With
End With
End Sub
Übrigens: Datenreihen, die auf die Primärachse gezeichnet werden, muss man die Achse nicht zuweisen, da die Primärachse die Standardachse ist.
Bis später
Karin
https://excel-inn.de/