Anzeige
Archiv - Navigation
1688to1692
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Legende in Diagramm automatisch anpassen
10.05.2019 10:16:07
Anton
Hallo Zusammen,
ich möchte ein Diagramm erstellen, welches automatisch die Anzahl an Legendeneinträgen (Datenreihen) anpassen; und zwar so, dass nur Datenreihen angezeigt werden zu denen auch Daten vorhanden sind.
Das Diagramm greift auf eine Tabelle zu in der alle potentiellen Datenreihennamen erfasst sind. Die zugehörigen Zeilen mit den Daten zu den Datenreihen sind entweder leer oder eben befüllt je nachdem ob daten vorhanden sind oder nicht.
Ich habe nun folgenden Plan, freue mich aber über einfachere Lösungswege:
1. In der Tabelle werden nur Zellen mit Inhalt markiert
2. Die Zellen werden kopiert
3. Die Zellen werden weiter unten im Datenblatt eingefügt
4. Ein Bereich wird erstellt, welcher sich automatisch an die Anzahl der vorhandenen Spalten/Zeilen anpasst
5. Das Diagramm bezieht sich auf diesen Bereich und passt sich damit automatisch an.
Ich habe dazu folgenden VBA Code zusammengebastelt:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngC As Range, rngF As Range
If Target.Address = "$I$3" Then
Set rngC = Worksheet("Jahr_Projekt").Range("A3:Z25").Cells.SpecialCells(xlCellTypeConstants)
Set rngF = Worksheet("Jahr_Projekt").Range("A3:Z25").Cells.SpecialCells(xlCellTypeFormulas)
Union(rngC, rngF).Select
Selection.Copy
Worksheet("Jahr_Projekt").Range("B31").Select
Worksheet("Jahr_Projekt").Paste
End If
End Sub


1. Ich erhalte nun die Fehlermeldung, das Sub ist nicht definiert o.Ä. und verstehe nicht wieso
2. Würde ich mich über Lösungsansätze zum o.g. Vorhaben freuen.
Vielen Dank im Voraus!
Euer Anton

23
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Legende in Diagramm automatisch anpassen
10.05.2019 11:42:00
Rainer
Hallo Anton,
ordne deinem Diagramm die ganze Tabelle zu. Dann prüfe ob Daten vorhanden sind. Wenn nicht, dann kannst du die Datenreihen ausblenden mit:
Worksheets(1).ChartObjects("Chart 1").Chart.FullSeriesCollection(1).IsFiltered = true
Gruß, Rainer
AW: Legende in Diagramm automatisch anpassen
10.05.2019 13:08:43
Anton
Hallo Rainer,
vielen Dank für deine Antwort. Die Legende (Datenreihen) manuell zu löschen ist natürlich der einfachste Weg. Dem Diagramm werden aber über eine Dropdown Liste verschiedene Daten zugespielt. Diese kommen zwar immer aus der selben Tabelle, bestehen aber aus unterschiedlichen Datenreihen. Wenn ich das Problem nach deinem Lösungsvorschlag löse müsste ich also nach jeder DropDownListen-Auswahl die Legende neu anpassen. Da das Ganze ein Dashboard wird, was leicht zu bedienen sein soll ohne unnötige Manuelle Eingriffe, soll sich die Legende aber automatisch anpassen.
Anzeige
AW: Legende in Diagramm automatisch anpassen
10.05.2019 13:17:18
Rainer
Hallo Anton,
wo hab ich denn von manuell geschrieben? Oder von löschen?
Anhand deiner Auswahlliste solltest du Datenreihen ausblenden, nichts löschen, nichts manuell.
Wollen wir das etwas abkürzen indem du einfach deine Datei hochlädst?
Gruß, Rainer
AW: Legende in Diagramm automatisch anpassen
10.05.2019 13:36:01
Anton
Hallo Rainer,
das ist eine super Idee. Danke Dir im Voraus! Hier ist der Link zum aktuellen Arbeitsstand:
https://www.herber.de/bbs/user/129704.xlsm
AW: Legende in Diagramm automatisch anpassen
10.05.2019 13:45:37
Rainer
Hallo Anton,
ich glaub da fehlt ein Diagramm?
Gruß, Rainer
AW: Legende in Diagramm automatisch anpassen
10.05.2019 14:10:30
Anton
Hallo Rainer,
entschuldige bitte
https://www.herber.de/bbs/user/129707.xlsm
Das Diagramm liegt im Blatt "Jahr_Projekte".
Das Diagramm bezieht sich auf die darüberliegende Tabelle. DIese ist eine Filterung der oberen Tabelle(nur Datenreihen "Mitarbeiter" mit Eintragungen werden runter kopiert - siehe Makro) - Das runterkopieren soll jedes mal passieren wenn man im Tabellenblatt "Summary" im Drop Down Menü eine neue Auswahl trifft geschehen. Das Makro dazu - welchen offenbar auch fehlerhaft ist - habe ich weiter oben gepostet - aber das ist ein anderen Thema :D
Ich danke dir sehr für deine Hilfe und Geduld. Wenn es zum Verständnis hilft können wir auch skypen!
Viele Grüße,
Anton
Anzeige
AW: Legende in Diagramm automatisch anpassen
10.05.2019 14:33:55
Rainer
https://www.herber.de/bbs/user/129708.xlsm
Ich meinte es so.
Es gibt ein neues Diagramm 2, auf welches sich Makro 1 bezieht.
Du brauchst die Daten für das Diagramm nicht nochmal filtern.
Sub Makro1()
Dim WS As Worksheet
Set WS = Worksheets("Jahr_Projekt")
For i = 1 To 22 'Anzahl Zeilen
WS.ChartObjects("Diagramm 2").Chart.FullSeriesCollection(i).IsFiltered = False
If WorksheetFunction.Sum(WS.Range(WS.Cells(i + 2, 3), WS.Cells(i + 2, 26))) = 0 Then _
WS.ChartObjects("Diagramm 2").Chart.FullSeriesCollection(i).IsFiltered = True
Next i
End Sub
Gruß, Rainer
Anzeige
AW: Legende in Diagramm automatisch anpassen
10.05.2019 15:11:54
Anton
Hallo Rainer,
vielen vielen Dank! So schön hätte ich es im Leben nicht hinbekommen!
Ich habe nun das Diagramm auf das Sheet "Summary" kopiert. Jetzt funktioniert dein Marko nicht mehr :D Ich habe mein bestes gegeben und es wie folgt editiert, ohne Erfolg.
Sub Makro1()
Dim WS As Worksheet
Set WS = Worksheets("Jahr_Projekt")
Set WSS = Worksheets("Summary")
For i = 1 To 22 'Anzahl Zeilen
WSS.ChartObjects("Diagramm 2").Chart.FullSeriesCollection(i).IsFiltered = False
If WorksheetFunction.Sum(WS.Range(WS.Cells(i + 2, 3), WS.Cells(i + 2, 26))) = 0 Then _
WSS.ChartObjects("Diagramm 2").Chart.FullSeriesCollection(i).IsFiltered = True
Next i
End Sub
Kannst Du mir sagen was jetzt noch falsch ist :D
Anzeige
AW: Legende in Diagramm automatisch anpassen
10.05.2019 15:19:11
Rainer
Hallo Anton,
ohne Mappe ist das schwierig.
Aber mein Verdacht wäre, dass sich der Name des Diagramms geändert hat? Ändere mal im Makro "Diagramm 2" in "Diagramm 1".
AW: Legende in Diagramm automatisch anpassen
10.05.2019 15:24:36
Anton
Top Rainer, Danke!
AW: Legende in Diagramm automatisch anpassen
10.05.2019 15:47:10
Rainer
Hallo Anton,
danke für die Rückmeldung. Wenn es noch wo klemmt, meld dich einfach.
Gruß, Rainer
AW: Legende in Diagramm automatisch anpassen
10.05.2019 16:08:28
Anton
Hallo Rainer,
ich möchte nun, dass dein Makro sich immer dann ausführt, wenn ich in einer Drop-Down Liste (Im Feld I3) eine Auswahl treffe. Dazu habe ich Dein Makro in die Tabelle "Summary" kopiert und wie folgt ergänzt - Leider ohne Erfolg. Es passiert einfach gar nichts :D
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Target.Address = "I3" Then
Dim WS As Worksheet
Set WS = Worksheets("Jahr_Projekt")
Set WSS = Worksheets("Summary")
For i = 1 To 22 'Anzahl Zeilen
WSS.ChartObjects("Diagramm 1").Chart.FullSeriesCollection(i).IsFiltered = False
If WorksheetFunction.Sum(WS.Range(WS.Cells(i + 2, 3), WS.Cells(i + 2, 26))) = 0 Then _
WSS.ChartObjects("Diagramm 1").Chart.FullSeriesCollection(i).IsFiltered = True
Next i
End If
End Sub
Ich würde mich über deine Hilfe dazu sehr freuen!
Grüße,
Anton
Anzeige
AW: Legende in Diagramm automatisch anpassen
10.05.2019 16:12:45
Rainer
Meinst du so?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$I$3" Then Makro1
End Sub
Dazu lass das Makro im Modul, da ist es besser aufgehoben.
Gruß, Rainer
AW: Legende in Diagramm automatisch anpassen
10.05.2019 17:25:21
Anton
Genau so! Merci!
AW: Legende in Diagramm automatisch anpassen
10.05.2019 17:53:19
Anton
Hallo Rainer,
und schon wieder komme ich nicht weiter...
Per Indirekt möchte ich Tabelleneinträge aus einem ausgewählten Datenblatt (z.B. anro) auf meinem Hilfsblatt (hiermit wird das Diagramm verbunden. Dazu nutze ich die folgende Formel:
=INDIREKT($A$2&"!E43")
$A$2 ist die Zelle in denen die Tabellenblätter stehen (z.B. anro). So wird also in der Formel der Wert aus der Zelle E43 im Datenblatt anro angezeigt.
Mein Problem:
Wenn ich nun die Zelle und die Formel nach rechts ziehe wird diese nicht wie gewöhnlich automatisch erweitert (beide Koordinaten), also: INDIREKT($A$2&"!E43") | INDIREKT($A$2&"!F43") | INDIREKT($A$2&"!G43") usw.
Gibt es eine Möglichkeit, dies zu ändern? Ich würde sonst jetzt die Formel in den jeweiligen Zellen per Hand erweitern und das fühlt sich nicht nach dem effizientesten Weg an :D
Viele Grüße,
Anton
Anzeige
AW: Legende in Diagramm automatisch anpassen
10.05.2019 20:03:19
Anton
Hallo Rainer,
o.g. Problem konnte ich in der Zwischenzeit alleine lösen über eine Hilfszeile mit den Buchstaben und Hilfsspalte mit den entsprechenden Zeilennummern...
Schönen Abend Dir!
AW: Legende in Diagramm automatisch anpassen
10.05.2019 21:36:03
Anton
Hallo!
Nun möchte ich gerne die Farben der Datenreihen den Farben im Blatt "Stammdaten" anpassen.
Hier zu habe ich den folgenden Code geschrieben, bekomme aber beim Ausführen die Fehlermeldung:
"Die Methode "ColorIndex" für das Objekt "Interior" ist fehlgeschlagen"
Die Idee ist, dass alle Datenreihen nacheinander durchlaufen werden, parallel dazu die gefärbten Zellen im Blatt "Stammdaten".
Findest Du den Fehler bzw. eine einfachere Lösung?
Sub DiaFaerben()
Dim WSS2 As Worksheet
Dim WSS1 As Worksheet
Set WSS1 = Worksheets("Summary")
Set WSS2 = Worksheets("Stammdaten")
Dim i As Integer
For i = 1 To 20
WSS1.ChartObjects("Diagramm 2").Chart.SeriesCollection(i).Interior.ColorIndex = WSS2.Cells(i +  _
25, 2).Interior.Color
Next i
End Sub
Vielen Dank im Voraus!
Anton
Anzeige
AW: Legende in Diagramm automatisch anpassen
10.05.2019 23:32:00
Rainer
Hallo Anton,
du musst "Color" statt "ColorIndex" schreiben, dann geht es.
Gute Nacht dann erstmal.
Rainer
AW: Legende in Diagramm automatisch anpassen
11.05.2019 10:23:18
Anton
Hi Rainer,
das ist schonmal angepasst, jetzt kommt der Fehler: "Parameter ungültig". Der Einfachheit halber habe ich den aktuellen Arbeitsstand hochgeladen:
https://www.herber.de/bbs/user/129712.xlsm
Grüße,
Anton
AW: Legende in Diagramm automatisch anpassen
11.05.2019 14:44:30
Rainer
Eigentlich alles richtig, nur hast du 11 Datenreihen im Chart und willst 20 einfärben. Darum kommt bei Nr 12 der Fehler.
Gruß, Rainer
Sub DiaFaerben()
Dim WSS2 As Worksheet
Dim WSS1 As Worksheet
Set WSS1 = Worksheets("Summary")
Set WSS2 = Worksheets("Stammdaten")
Dim i As Integer
For i = 1 To WSS1.ChartObjects("Diagramm 2").Chart.SeriesCollection.Count
WSS1.ChartObjects("Diagramm 2").Chart.SeriesCollection(i).Interior.Color = WSS2.Cells(i + 25, 2) _
.Interior.Color
Next i
End Sub

Anzeige
AW: Legende in Diagramm automatisch anpassen
11.05.2019 15:03:36
Anton
Super! Danke! Habs mit
For i = 1 To WSS1.ChartObjects("Diagramm 2").Chart.SeriesCollection.Count
gelöst
AW: Legende in Diagramm automatisch anpassen
11.05.2019 18:30:08
Anton
Hallo Rainer,
ich bin wieder ein paar Schritte weiter gekommen und stehe nun vor folgendem Problem:
Im Tabellenblatt "anro" kann man in der zweiten Zeile per Dropdown Menü Projekte vom Tabellenblatt "Stammdaten" auswählen. Dies geschieht über die Listenzuordnung "=Land". Ich möchte nun durch aktivieren der Checkbox links neben dieser Legende die Listenzuordnung der Zellen in der zweiten Zeile (B2:Y2) löschen. Bei deaktivierter Checkbox soll die Listenzuordnung "=Land" wiederhergestellt werden, sodass der zugehörige Code welcher nach Zellen mit dieser Listenzuordnung sucht wieder funktioniert.
In meiner Variante versuche ich dies wie folgt zu machen:
Range("B2:Y2").Validation.Formula1 = ""
bzw.
Range("B2:Y2").Validation.Formula1 = "=Land"
Dies funktioniert aber nicht. Anbei sende ich den Code aus dem Tabellenblatt sowie den aktuellen Arbeitsstand.
Ich würde mich sehr freuen wenn Du mir mal wieder aus der Patsche hilfst :)
Arbeitsstand:
https://www.herber.de/bbs/user/129717.xlsm
Code aus Tabellenblatt:
Option Explicit
Sub SimulationCheckBox()
With ActiveSheet.Shapes(Application.Caller).OLEFormat.Object
.Font.Name = "Wingdings"
.Font.Size = 40
If .Text = Chr(254) Then 'deaktiviert
.Text = Chr(168)
Range("B2:Y2").Validation.Formula1 = ""
Range("B2:Y2").SpecialCells(xlCellTypeConstants).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = 0
.Weight = xlThick
End With
Else 'aktiviert
.Text = Chr(254)
Range("B2:Y2").Validation.Formula1 = "=Land"
Range("B2:Y2").Select
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDash
.ThemeColor = 6
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDash
.ThemeColor = 6
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDash
.ThemeColor = 6
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDash
.ThemeColor = 6
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End With
End Sub

Anzeige
AW: Legende in Diagramm automatisch anpassen
11.05.2019 20:52:12
Anton
Ich habe das Thema als neuen Beitrag formuliert! Danke für deine großartige Hilfe in den letzten 48 Stunden! Du hast mir sehr geholfen mich etwas im VBA Labyrinth zurechtzufinden!
Viele Grüße
Anton

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige