Kreisdiagramm dynamisch färben

[Linuxer]

Hallo zusammen,

Heute habe ich eine einfache Tabelle erstellt:

Code:

+--------------------------+
| Kategorie    | Bewertung |
+--------------------------+
| Kat 1        | 66%       |
+--------------------------+
| Kat 2        | 72%       |
+--------------------------+
| Kat 3        | 44%       |
+--------------------------+
| Kat 4        | 70%       |
+--------------------------+
| Kat 5        | 46%       |
+--------------------------+

Die Zellen mit den Prozentwerten habe ich
per bedingter Formatierung eingefärbt.

0% - 49,99% = rot
50% - 69,99% = orange
70% - 79,99% = gelb
80% - 94,99% = hellgrün
95% - 100% = dunkelgrün

Bis hier ist alles okay.

Für die Tabelle baute ich dann ein Kreisdiagramm,
welches die Prozentwerte in den 5 Abschnitten anzeigt.
Die Abschnitte habe ich dann allerdings manuell
eingefärbt.

Ist es möglich die Färbung der Kreisabschnitte abhängig
von der Liste (rot, orange usw.), also im Prinzip mit einer
bedingten Formatierung, dynamisch vorzunehmen?

Danke und Gruß
Linuxer

[UweD]

Hallo

hier mal was über VBA (vorrausgesetzt du hast die Datenbeschriftung eingeschaltet

Code:

'In ein Modul
Sub FarbeNachWert()
    Dim cht As Chart
    Dim i As Integer
    Dim punktWert As Integer

    Set cht = ActiveSheet.ChartObjects("Diagramm 1").Chart

    With cht.SeriesCollection(1)
        For i = 1 To .Points.Count
            punktWert = Replace(.Points(i).DataLabel.Text, "%", "")

            Select Case punktWert
                Case Is >= 95
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(0, 150, 0) ' dunkel Grün
                Case Is >= 80
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(0, 255, 0) ' hell Grün
                Case Is >= 70
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(255, 255, 0) ' Gelb
                Case Is >= 50
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(255, 100, 0) ' Orange
                Case Else
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(255, 0, 0) ' Rot
            End Select
        Next i
    End With
End Sub

Code:

'in den Codebereich der Tabelle
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RNG As Range
    Set RNG = Range("B1:B5")
   
    If Not Intersect(Target, RNG) Is Nothing Then
        Call FarbeNachWert
    End If
End Sub

LG UweD

[UweD]

Hallo nochmal


Hiermit wird direkt auf die Y-Werte zugegriffen

Einfach austauschen

Code:

Sub FarbeNachWert()
    Dim yValues As Variant
    Dim i As Integer
    Dim punktWert

    With ActiveSheet.ChartObjects("Diagramm 1").Chart.SeriesCollection(1)
        yValues = .Values
        For i = LBound(yValues) To UBound(yValues)
            punktWert = yValues(i)

            Select Case punktWert
                Case Is >= 0.95
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(0, 150, 0) ' dunkel Grün
                Case Is >= 0.8
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(0, 255, 0) ' hell Grün
                Case Is >= 0.7
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(255, 255, 0) ' Gelb
                Case Is >= 0.5
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(255, 100, 0) ' Orange
                Case Else
                    .Points(i).Format.Fill.ForeColor.RGB = RGB(255, 0, 0) ' Rot
            End Select
        Next i
    End With
End Sub

LG UweD

[Linuxer]

Hi UweD,

vielen herzlichen Dank. Die Scripts laufen super. 
Auch auf andere Diagrammtypen lässt sich das
anwenden.

Besten Dank
Linuxer