Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1692to1696
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
Inhaltsverzeichnis

Diagramm Treemap mit farbiger Skalierung

Diagramm Treemap mit farbiger Skalierung
24.05.2019 11:19:13
MarC
Hallo alle zusammen,
ich versuche gerade eine Treemap zu erstellen die eine grün - rot Skalierung hat. Mit der Treemap möchte die Prozessqualität abbilden. Ich habe z.B. 10 Prozesse von denen 9 Prozesse zwischen 90 - 100% haben. Diese werden in unterschiedliche hell und dunkel grün Tönen abgebildet. Ein Prozess ist unter 90% und sollte daher rot sein. je nachdem wie weit der Prozess unter 90% ist sollte er von leicht hell rot immer dunkler werden.
Ist das überhaupt möglich? Wenn ja wie? Kann mir hierbei bitte jemand helfen, da ich bei dieser Darstellungsart noch nicht viel Erfahrung habe. Zum besseren Verständnis habe ich ein Beispiel angehängt.
Userbild

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Diagramm Treemap mit farbiger Skalierung
24.05.2019 11:37:08
Rainer
Hallo Marc,
hast du eine Beispielmappe?
Es ist per VBA möglich, die Werte einzufärben.
Gruß, Rainer
Treemap Diagramm ist nicht VBA kompatibel!
24.05.2019 13:11:37
Rainer
Hallo Marc,
ich muss mich entschuldigen, aber leider geht es nicht so wie ich gedacht habe.
Ich habe hier ein Makro, welches Diagramme einfärben kann. Es übernimmt die Farbe der Zelle, aus welcher der Diagrammwert stammt. Somit kannst du die Zellen mit bedingter Formatierung färben und das Makro übernimmt die Farben ins Diagramm.
Nur leider gibt es bestimmte Diagrammtypen, welche nicht kompatibel sind. Treemap ist ein neuer Diagrammtyp in Excel und funktioniert nicht. Es ist anscheinend nicht möglich, per VBA Farben zu ändern.
Sub Conditional_Format_for_Graphs_V2()
'Select a Series from a Chart, the Points will be coloured according to the Backgraund Colour
'Also works with Conditional Formating of the Cells
'Tested for Point Charts and Column Charts
Dim RaZelle As Range
On Error Resume Next
Test = ActiveChart.Name
If IsEmpty(ActiveChart.Name) Then
MsgBox "Select Graph first", vbCritical
Exit Sub
End If
If TypeName(Selection) = "Series" Then
Set ch = ActiveChart.SeriesCollection
For SeriesI = 1 To ch.Count
If ch(SeriesI).Name = Selection.Name Then I = SeriesI
Next SeriesI
Else
MsgBox "Select Series first", vbCritical
Exit Sub
End If
SeriesI = I
SeriesFormula = ActiveChart.SeriesCollection(SeriesI).Formula
X1 = InStr(SeriesFormula, ",")             'Ende Name
X1 = InStr(X1 + 1, SeriesFormula, ",")      'Ende X-Achse
X2 = InStr(X1 + 1, SeriesFormula, "!")      'Ende Blattname
X1 = InStr(X1 + 1, SeriesFormula, ",")
ValueRange = Mid(SeriesFormula, X2 + 1, X1 - X2 - 1)
I = 1
For Each RaZelle In ActiveSheet.Range(ValueRange)
If RaZelle.DisplayFormat.Interior.Color  16777215 Then
ActiveChart.SeriesCollection(SeriesI).Points(I).Format.Fill.ForeColor.RGB = _
RaZelle.DisplayFormat.Interior.Color
End If
I = I + 1
Next RaZelle
End Sub
Das Problem liegt hier. Die erste Code-Zeile funktioniert für ein "normales" Diagramm. Die zweite Zeile stammt vom Recorder, wenn man das Treemap Diagramm ändern will.
ActiveChart.SeriesCollection(SeriesI).Points(I).Format.Fill.ForeColor.RGB = _
RaZelle.DisplayFormat.Interior.Color
ActiveChart.FullSeriesCollection(0).Points(3).ApplyDataLabels

Anzeige
Hat jemand eine Idee?
24.05.2019 14:40:07
MarC
Schade Rainer. Ich hätte mich echt gefreut wenn das gehen würde, aber trotzdem vielen Dank. Vielleicht hat ja irgendjemand da draußen eine Idee wie es doch gehen könnte. Wenn es nicht geht darf der Beitrag als geschlossen angesehen werden.
VG Marc
Diagramm einfärben
26.05.2019 01:27:27
Peter
Hallo Marc,
nach längerem Probieren habe ich eine Lösung gefunden. Leider lassen sich die RAL-Farben nicht durch Varianten erzeugen; ich habe daher für jede Farb-Variante einen eigenen Unter-Makro gebildet. Hier meine Datei:
https://www.herber.de/bbs/user/130023.xlsm
Bitte mal ausprobieren, Rückmeldung wäre schön.
M.f.G. Peter Kloßek
Anzeige
Super Diagramm =D
26.05.2019 08:45:29
Marc
Morgen Peter,
ich habe gerade das Makro getestet, die Prozesse von 10 auf 25 erweitert und andere Farben hergenommen und dabei ist mir aufgefallen das es super funktioniert =D. Echt starkes Ding ich hätte nicht gedacht, dass das mit Excel geht. Vielen Dank.
... und sie dreht sich doch!
26.05.2019 12:50:36
Rainer
Hallo Marc,
Peter Kloßek hat super Arbeit abgeliefert!
Mich hat es aber auch nicht so ganz in Ruhe gelassen.
So kann mein Makro auch Treemap Charts färben:
Sub Conditional_Format_for_Graphs_V2()
'Select a Series from a Chart, the Points will be coloured according to the Backgraund Colour
'Also works with Conditional Formating of the Cells
'Tested for Point Charts and Column Charts
'Update: Treemap works now
Dim RaZelle As Range
On Error Resume Next
test = ActiveChart.Name
If IsEmpty(ActiveChart.Name) Then
MsgBox "Select Graph first", vbCritical
Exit Sub
End If
If TypeName(Selection) = "Series" Then
Set ch = ActiveChart.SeriesCollection
For SeriesI = 1 To ch.Count
If ch(SeriesI).Name = Selection.Name Then I = SeriesI
Next SeriesI
Else
MsgBox "Select Series first", vbCritical
Exit Sub
End If
SeriesI = I
SeriesFormula = ActiveChart.SeriesCollection(SeriesI).Formula
X1 = InStr(SeriesFormula, ",")             'Ende Name
X1 = InStr(X1 + 1, SeriesFormula, ",")      'Ende X-Achse
X2 = InStr(X1 + 1, SeriesFormula, "!")      'Ende Blattname
X1 = InStr(X1 + 1, SeriesFormula, ",")
ValueRange = Mid(SeriesFormula, X2 + 1, X1 - X2 - 1)
If ValueRange = "" Then                 'Treemap
Dim chtObj1 As ChartObject
Dim chtObj2 As ChartObject
Set chtObj1 = ActiveChart.Parent
Set chtObj2 = chtObj1.Duplicate.Chart.Parent
chtObj2.Activate
ActiveChart.ChartType = xlLine
SeriesFormula = ActiveChart.SeriesCollection(1).Formula
X1 = InStr(SeriesFormula, ",")             'Ende Name
X1 = InStr(X1 + 1, SeriesFormula, ",")      'Ende X-Achse
X2 = InStr(X1 + 1, SeriesFormula, "!")      'Ende Blattname
X1 = InStr(X1 + 1, SeriesFormula, ",")
ValueRange = Mid(SeriesFormula, X2 + 1, X1 - X2 - 1)
ActiveChart.Parent.Delete
chtObj1.Activate
ActiveChart.FullSeriesCollection(1).Select
End If
I = 1
For Each RaZelle In ActiveSheet.Range(ValueRange)
If RaZelle.DisplayFormat.Interior.Color  16777215 Then
ActiveChart.SeriesCollection(SeriesI).Points(I).Format.Fill.ForeColor.RGB = _
RaZelle.DisplayFormat.Interior.Color
End If
I = I + 1
Next RaZelle
End Sub
Du musst aber darauf achten, dass dein Treemap auch wirklich nur eine Datenreihe hat. In deiner Beispieldatei hatte es 3 Reihen, wovon aber nur eine dargestellt wurde.
Gruß, Rainer
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige