Balkenfarbe abhängig von Zellenwerten

Dieses Thema im Forum "Excel und VBA" wurde erstellt von frank_frank, 18 Dezember 2006.

  1. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    Guten Tag,

    ich möchte ein Balkendiagramm erstellen. Die Balkenlänge wird aus einer Spalte ausgelesen, deren Zellenwertbereich nicht zusammenhängt. Die Anzahl der Werte steht fest, die Zeilen können sich jedoch noch verschieben. (Dies wird meines Wissens jedoch sowieso automatisch vom Diagramm übernommen)

    Ich möchte nun die jeweilige Balkenfarbe abhängig von einem Zellenwert darstellen. Jedoch ist die Balkenfarbe nicht abhängig vom o.g. Wert, sondern vom jeweiligen Wert in der Zelle daneben (1,2 oder 3). Im Netz habe ich ein Beispieldiagramm gefunden, das mir per VBA zumindest die Balkenfarbe abhängig von der Balkenlänge einfärbt, vielleicht kann man das weiterentwickeln.http://www.jumper.ch/Diagramme/BedFormat_Saulen.xls

    Vielen Dank für Eure Hilfe!

    Gruß
    Frank
     
  2. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Hallo Frank,

    Wenn es nur (sehr) wenige Werte sind, geht z.B. sowas.

    Liest die Werte der Balken aus Spalte A, die Farben aus Spalte B.

    Ansonsten bringe mal ein Beispiel Deines Tabellenaufbaus.

    cu, Bernd
    --
    Code:
    Option Explicit
    
    Sub x()
       Dim arWerte() As Variant, arFarbe() As Variant, intAnzWerte, i&, j&
       
       intAnzWerte = WorksheetFunction.Count(ActiveSheet.Columns(1))
       If intAnzWerte < 2 Then Exit Sub
       ReDim arWerte(1 To intAnzWerte)
       ReDim arFarbe(1 To intAnzWerte)
       
       j = 1
       For i = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
          If Not IsEmpty(Cells(i, 1).Value) And IsNumeric(Cells(i, 1).Value) Then
             arWerte(j) = Cells(i, 1)
             arFarbe(j) = Cells(i, 2)
             j = j + 1
          End If
       Next
       With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
          .Values = arWerte
          For i = 1 To intAnzWerte
             .Points(i).Interior.ColorIndex = arFarbe(i)
          Next
       End With
    End Sub
     
  3. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    hallo bernd,

    es sind insgesamt 16 werte, die anzahl steht auch fest. ich teste nachher mal!

    gruß
    frank
     
  4. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    Hallo Bernd,

    ich bin leider schon im Ansatz gescheitert. Ich habe deshalb mal die Excel-Tabelle hochgeladen. Im 1. Tabellenblatt sieht man das Diagramm, aus dem 2. Blatt werden die Werte gelesen. Die Balkenlänge wird aus SpalteF gelesen, und zwar aus genau den Zeilen, die bereits mit Dummy-Werten gefüllt sind. Aus den Zellen der Spalte G soll dann die Balkenfarbe ausgelesen werden, und zwar analog der bedingten Formatierung (hier 1=rot, 2=gelb, 3=grün, wobei das sicherlich flexibel ist).

    Ich hoffe, das hilft ein wenig weiter...

    Gruß
    Frank
     

    Anhänge:

  5. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Hallo Frank,

    Die Farbe einer bedingten Formatierung (CF) in VBA auszulesen ist irgendwo zwischen extrem schwierig und nahezu unmöglich. Ändere deshalb Deine CF einfach so ab, daß sie dem Colorindex der Farbe entspricht. D.h. 3=Rot, 6=Gelb und Grün=4. Dann kann man den Wert der Farbe direkt aus der Zelle lesen. Und sowas wie unten sollte funktionieren.

    HTH, Bernd
    --
    Code:
    Option Explicit
    
    Sub x()
       Dim arWerte() As Variant, arFarbe() As Variant, intAnzWerte, i&, j&
       
       With Worksheets("Übersicht")
          intAnzWerte = WorksheetFunction.Count(.Columns(6))
          If intAnzWerte < 2 Then Exit Sub
          ReDim arWerte(1 To intAnzWerte)
          ReDim arFarbe(1 To intAnzWerte)
       
          j = 1
          For i = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
             If Not IsEmpty(Cells(i, 6).Value) And IsNumeric(Cells(i, 6).Value) Then
                arWerte(j) = Cells(i, 6)
                arFarbe(j) = Cells(i, 7).Value
                j = j + 1
             End If
          Next
       End With
       With Worksheets("Grafische Übersicht").ChartObjects(1).Chart.SeriesCollection(1)
          .Values = arWerte
          For i = 1 To intAnzWerte
             .Points(i).Interior.ColorIndex = arFarbe(i)
             .Points(i).Interior.Pattern = xlSolid
          Next
       End With
    End Sub
     
  6. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    Hallo Bernd,

    danke schonmal! Noch zwei Fragen bzw. Hinweise:
    Kopiere ich den Code in "Diese Arbeitsmappe" und wird der Code automatisch ausgeführt?

    Leider sind im Diagramm nun keine Balken mehr zu sehen...
     
  7. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Hi,

    der Code gehört in ein normales Modul und wird nicht automatisch ausgeführt.

    Da waren auch noch ein paar Punkte zuwenig :-(

    Jetzt mit Button.

    cu, Bernd
     
    #7 bst, 18 Dezember 2006
    Zuletzt bearbeitet: 6 Dezember 2007
  8. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    hallo bernd,

    das sieht ja super aus! vielleicht noch als hintergrund, damit du auch weißt, wieso ich das haben möchte:

    unabhängig vom prozentualen grad kann man bei bestimmten zielen den status anders bewerten... u.a. bei nicht-linearem verlauf.

    vielen dank nochmal!

    grüße
    frank
     
  9. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    Guten Morgen,

    eine Frage noch: wenn man im Tabellenblatt "Übersicht" die 1. Gliederungsebene einstellt, entsteht bei der grafischen Übersicht ein VB-Laufzeitfehler, da die erforderlichen Zeilen ausgeblendet sind. Bei allen anderen Ansichten bis zur 4. Ebene gibt es dann kein Problem mehr, auch nicht bei zusätzlich eingefügten Zeilen. (Die erforderlichen Zellen werden ab der 2. Gliederungsebene eingeblendet)

    Müssen die Zeilen für die grafische Ansicht unbedingt eingeblendet sein oder kann das Diagramm die Werte auch aus ggf. ausgeblendeten Zeilen lesen?

    Gruß
    Frank
     
  10. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    Ein weiteres Problem tut sich auf: die Anzahl der Datenwerte (und damit der Balken) sollte fest vorgegeben sein, durch das Makro wird die Anzahl jedoch aus der Spalte ausgelesen. Wenn ich in der Splate weitere Werte eingebe, die jedoch nicht grafisch dargestellt werden sollen, erscheinen sie trotzdem im Diagramm.

    Kann man die darzustellenden Zellen evtl. mit Zellennamen direkt ansteuern?
     
    #10 frank_frank, 20 Dezember 2006
    Zuletzt bearbeitet: 20 Dezember 2006
  11. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Hallo Frank,

    1. ich bekomme keinen Fehler, es werden allerdings zu wenige Werte eingelesen da .Cells.SpecialCells(xlCellTypeLastCell).Row wegen der ausgeblendeten Zellen einen zu kleinen Wert liefert.

    2. Wie stellst Du Dir das vor ?
    Wenn denn z.B. in der Spalte F 20 Werte stehen und Du davon nur 10 in der Grafik haben möchtest, welche davon denn ??

    cu, Bernd
     
  12. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    Gruß
    Frank
     
  13. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    Das 1. Problem habe ich mit der Ergänzung

    Worksheets("Übersicht").Outline.ShowLevels RowLevels:=2

    im Makro gelöst, so dass zumindest beim Update die 2. Ebene angezeigt wird und somit die Daten ausgelesen werden können.
     
  14. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Morgen Frank,

    wenn es sich immer um die gleichen Zellen handelt geht das viel einfacher:

    - Markiere alle diese Zellen (nimm die STRG-Taste zur Hilfe) und gib ihnen einen Namen, z.B. myData

    - schreibe ins Diagramm unter Datenquelle - Reihe - Werte

    =Übersicht.xls!myData

    Nun reicht es aus die Farben zu ändern, versuche mal sowas:

    Code:
    Option Explicit
    
    Sub SetzeDiaFarben()
       Dim rngZelle As Range, i As Integer
       
       Worksheets("Übersicht").Outline.ShowLevels RowLevels:=2
       With Worksheets("Grafische Übersicht").ChartObjects(1).Chart.SeriesCollection(1)
          i = 1
          For Each rngZelle In Range("myData")
             .Points(i).Interior.ColorIndex = rngZelle.Offset(0, 1).Value
             .Points(i).Interior.Pattern = xlSolid
             i = i + 1
          Next
       End With
    End Sub
    HTH, Bernd
     
  15. frank_frank

    frank_frank
    Expand Collapse
    New Member

    Registriert seit:
    18 Dezember 2006
    Beiträge:
    48
    Zustimmungen:
    0
    Hallo Bernd,

    klappt wunderbar, vielen Dank! Schöne Feiertage und einen guten Start ins neue Jahr!

    Grüße
    Frank
     
Die Seite wird geladen...

Diese Seite empfehlen