Microsoft Excel

Herbers Excel/VBA-Archiv

Balkenfarbe-Script vereinfachen

Betrifft: Balkenfarbe-Script vereinfachen von: mokia
Geschrieben am: 11.11.2014 11:43:47

Hallo,

ich habe mit eure Hilfe folgendes, funktionierendes Script. Je nach "Wert" wird der dazugehörige Balken blau oder rot. Jetzt sind die vielen ElseIf-Befehle sehr unschön. Ich würde gern die Zuordnung "WertXY" zu rot oder blau nicht im Script direkt sondern in einem extra Tabellenblatt pflegen (s. Screenshot). Insbesondere da es sich um insgesamt ca.50 Werte handelt und auch manchmal welche ergänzt werden. Vielen Dank für eure Hilfe!

Sub Diagramm_formatieren()

    Dim rng As Range
    Dim i As Long
    Dim a As Long
    Dim l As Long
    Dim e As Long
        
        a = 0
    For l = 1 To Worksheets(1).ChartObjects("Diagramm 1").Chart.
            SeriesCollection(1).Points.Count
        Worksheets(1).ChartObjects("Diagramm 1").Chart.
        SeriesCollection(1).Points(l).Interior.ColorIndex = 1
    Next l
    

    
    For i = 1 To Worksheets(1).Range("H2").End(xlDown).Row
        Set rng = Worksheets(1).Range("H2").Offset(i - 1, 0)
        If rng.EntireRow.Hidden = False Then
            If rng.Value = "Wert1" Then
                Worksheets(1).ChartObjects("Diagramm 1").Chart.
                SeriesCollection(1).Points(i - a).Interior.ColorIndex = 3
            ElseIf rng.Value = "Wert2" Then
                Worksheets(1).ChartObjects("Diagramm 1").Chart.
                SeriesCollection(1).Points(i - a).Interior.ColorIndex = 3
            ElseIf rng.Value = "Wert3" Then
                Worksheets(1).ChartObjects("Diagramm 1").Chart.
                SeriesCollection(1).Points(i - a).Interior.ColorIndex = 5
            ElseIf rng.Value = "Wert4" Then
                Worksheets(1).ChartObjects("Diagramm 1").Chart.
                SeriesCollection(1).Points(i - a).Interior.ColorIndex = 5
            ElseIf rng.Value = "Wert5" Then
                Worksheets(1).ChartObjects("Diagramm 1").Chart.
                SeriesCollection(1).Points(i - a).Interior.ColorIndex = 5
            ElseIf rng.Value = "Wert6" Then
                Worksheets(1).ChartObjects("Diagramm 1").Chart.
                SeriesCollection(1).Points(i - a).Interior.ColorIndex = 3
            ElseIf rng.Value = "Wert7" Then
                Worksheets(1).ChartObjects("Diagramm 1").Chart.
                SeriesCollection(1).Points(i - a).Interior.ColorIndex = 3
            End If
        Else
            a = a + 1
        End If
    Next i
End Sub


  

Betrifft: AW: Balkenfarbe-Script vereinfachen von: ChrisL
Geschrieben am: 11.11.2014 13:06:22

Hi

Hier ein Ansatz, ungetestet ;)

Sub Diagramm_formatieren()

    Dim rng As Range
    Dim i As Long
    Dim a As Long
    Dim l As Long
    Dim e As Long
    Dim WS As Worksheet
    
    Set WS = Worksheets("Hilfstabelle") ' Tabellennamen anpassen
    
        a = 0
    For l = 1 To Worksheets(1).ChartObjects("Diagramm 1").Chart.SeriesCollection(1).Points. _
Count
        Worksheets(1).ChartObjects("Diagramm 1").Chart.SeriesCollection(1).Points(l).Interior. _
ColorIndex = 1
    Next l
    

    
    For i = 1 To Worksheets(1).Range("H2").End(xlDown).Row
        Set rng = Worksheets(1).Range("H2").Offset(i - 1, 0)
        If rng.EntireRow.Hidden = False Then
        
            If WorksheetFunction.CountIf(WS.Columns(1), rng) > 0 Then _
                Worksheets(1).ChartObjects("Diagramm 1").Chart.SeriesCollection(1).Points(i - a) _
.Interior.ColorIndex = 3
            If WorksheetFunction.CountIf(WS.Columns(2), rng) > 0 Then _
                Worksheets(1).ChartObjects("Diagramm 1").Chart.SeriesCollection(1).Points(i - a) _
.Interior.ColorIndex = 5
        
        Else
            a = a + 1
        End If
    Next i
End Sub

cu
Chris


  

Betrifft: AW: Balkenfarbe-Script vereinfachen von: mokia
Geschrieben am: 11.11.2014 15:32:29

Klasse - funktioniert :)
Hab nur noch EndIF an die entsprechenden Stellen eingefügt.
Vielen Dank


 

Beiträge aus den Excel-Beispielen zum Thema "Balkenfarbe-Script vereinfachen"