Farben Blasen-Diagramm

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Label
Bild

Betrifft: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 06.07.2015 20:16:07

https://www.herber.de/forum/archiv/1344to1348/t1345945.htm
Hallo Karin, hallo zusammen,
in obenstehendem Thread ist ein Makro enthalten, welches ein Blasen Dia beschriften lässt, basierend auf einer Wunschzeile ausgehend von der Position der X Zeile.
Das funktioniert super. Ich habe so zum Beispiel variable Beschriftungen für die TOP 3,5, 10, 80%, FLOP 5,10,20 (jeweils einzelne Zeilen) etc. mit Schaltflächen eingebaut.
Nun meine eigentliche Frage:
Ich würde diese Punkte auch jeweils gern anders einfärben, allerdings per separater Schaltfläche/Makro.
Beispiel:
-Klick Beschrifte TOP 3
-Klick Färbe TOP 3 anders ein.(blau)
Gibt es dafür ein Makro oder muss ich das über verschiedene Y Achsen machen.
Letzteres wäre recht aufwändig da ich viele Zeilen bzw. wählbare Beschriftungen habe.
ich würde die separate Farbwahl dann auch gern per Klick wieder zurücksetzen.
Herzlichen Dank für Eure Hilfe!!

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Beverly
Geschrieben am: 06.07.2015 20:27:31
Hi Marc,
das ist schon per VBA machbar, wäre aber gut, wenn du deine Mappe hochladen würdest.




Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 06.07.2015 20:59:07
Guten Abend Karin,
selbstverständlich:
https://www.herber.de/bbs/user/98673.xlsm
Die echte Datei enthält natürlich 1000e Datensätze und mehr Beschriftungsfilter.
Sie ist auch dynamisch etc.
Das mit der variablen Beschriftung ist eine gute Sache. Ich habe eine Weile gesucht und bin sehr froh Deinen Code gefunden zu haben.
P.s. noch habe ich das Löschen der Beschriftungen per separatem Makro laufen. Kann man das integrieren (2x klicken)?
Danke u. liebe Grüße aus dem Norden,
Marc

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 06.07.2015 21:04:14
Ach Gott: noch eine Frage. Kann man die Schriftart/Größe/Farbe eigentlich noch einstellen bei dem Beschriftungsmakro. Standardmäßig haut Excel da so eine mini Calibri Schrift raus;) Ich hatte nachgelesen dass es mit Font etc. Befehl geht.
Doch wo muss der rein. VBA Laie ;(

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Beverly
Geschrieben am: 07.07.2015 08:23:51
Hi Marc,
hier die Codes für die Färbung

Sub Top3()
    Dim lngPunkt As Long
    Dim serReihe As Series
    Dim strFormel As String
    With ActiveSheet.ChartObjects(1).Chart
        Set serReihe = .SeriesCollection(1)
        With serReihe
            strFormel = Application.Substitute(Split(.Formula, ",")(4), ")", "")
            For lngPunkt = 1 To .Points.Count
                If Range(strFormel).Cells(lngPunkt) >= Application.Large(Range(strFormel), 3)  _
Then
                    With serReihe.Points(lngPunkt).Format.Fill
                        .Visible = msoTrue
                        .ForeColor.ObjectThemeColor = msoThemeColorAccent2  '<== anpassen
                    End With
                End If
            Next lngPunkt
        End With
    End With
End Sub
Sub Prozent80()
    Dim lngPunkt As Long
    Dim serReihe As Series
    Dim strFormel As String
    With ActiveSheet.ChartObjects(1).Chart
        Set serReihe = .SeriesCollection(1)
        With serReihe
            strFormel = Application.Substitute(Split(.Formula, ",")(4), ")", "")
            For lngPunkt = 1 To .Points.Count
                If Range(strFormel).Cells(lngPunkt) >= Application.Max(Range(strFormel)) * 0.8  _
Then
                    With serReihe.Points(lngPunkt).Format.Fill
                        .Visible = msoTrue
                        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
                    End With
                End If
            Next lngPunkt
        End With
    End With
End Sub
Der Code für das Zurücksetzen der Farben - gilt sowohl für Top 3 als auch für 80%, falls die Färbung in beiden Fällen dieselbe ist:
Sub FarbeZurueck()
    Dim lngPunkt As Long
    Dim serReihe As Series
    With ActiveSheet.ChartObjects(1).Chart
        Set serReihe = .SeriesCollection(1)
        With serReihe
            For lngPunkt = 1 To .Points.Count
                With serReihe.Points(lngPunkt).Format.Fill
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = msoThemeColorAccent1
                End With
            Next lngPunkt
        End With
    End With
End Sub

Bezüglich der Beschriftung:
Sub Beschriftung()
   Dim strFormel As String
   Dim rngBereich As Range
   Dim intPunkt As Integer
   With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
      If .HasDataLabels = True Then
        ' Beschriftung löschen falls vorhanden
        .DataLabels.Delete
      Else
        .ApplyDataLabels
        strFormel = .Formula
        Set rngBereich = Range(Split(strFormel, ",")(1))
        For intPunkt = 1 To .Points.Count
           .Points(intPunkt).DataLabel.Text = rngBereich.Cells(intPunkt).Offset(0, -1)
        Next intPunkt
        ' Schrift - Werte entsprechend anpassen
        With .DataLabels.Font
          .Name = "Arial"
          .Size = 8
          .Color = 255
        End With
      End If
   End With
End Sub



Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 07.07.2015 11:29:08
Hallo Karin,
bin beeindruckt, klasse, vielen Dank und Gruß nach Freiberg!
Habe es ausprobiert..
Das mit der Zuweisung der Einfärbemakros der Top 3 und Top 80 klappt bei mir noch nicht ganz.
Ich füge den Code ein, dann erscheinen Modul1 und Modul 2 mit gleichem Namen..er färbt dann nur die Top 3 ein. Was mache ich falsch.
Darf ich Dich denn noch mit einer weiteren Sache belästigen?? liebschau
Das Diagramm macht langsam richtig Spaß..
Ich erläutere einmal den Hintergrund.
Wir haben hier jede Menge Marken, die in den einzelnen Ländern vertreten sind.
So kann z.B. Adidas und Nike in DEU, Puma und Nike in RUS, Adidas nur in SPA u.s.w. vertreten sein.
Um den direkten Vergleich auch zwischen den Marken zu haben, wäre es sinnvoll, wenn an die Blasen nach den Marken einfärbt (generell adidas immer rot).
Da man dann schon Farbvielfalt hat, könnte man zur Hervorhebung unserer variablen Beschriftungen die Blasen mit Beschriftung einfach dick umrahmen..
Ist das zuviel verlangt?
Das wäre natürlich spitze..es hilft unheimlich bei der Masse an Punkten (Wolke) schonmal die Marken optisch zu unterscheiden z.B. Preisniveau von Nike (grün) in der Punktewolke liegt über Adidas (rot)...
VG Marc
Anbei der aktuelle Stand.
https://www.herber.de/bbs/user/98680.xlsm
P.s. woher weiß die Farbformel dass Sie auf den Top 3 oder Top 80 Filter gehen muss. Ich habe ja noch mehrere Filter, denen ich dann jeweils eine besondere Markierung zuweisen muss.

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Beverly
Geschrieben am: 07.07.2015 16:56:29
Hi Marc,
ich war von einer falschen Voraussetzung bei der Berechnung deiner Top-Werte ausgegangen - so sollte der Code für beide Varianten funktionieren:

Sub Top_3()
    Dim lngPunkt As Long
    Dim serReihe As Series
    Dim strFormel As String
    With ActiveSheet.ChartObjects(1).Chart
        Set serReihe = .SeriesCollection(1)
        With serReihe
            If .HasDataLabels = True Then .DataLabels.Delete
            .ApplyDataLabels
            ' Schrift - Werte entsprechend anpassen
            With serReihe.DataLabels.Font
              .Name = "Arial"
              .Size = 10
              .Color = 255
            End With
            strFormel = Application.Substitute(Split(.Formula, ",")(4), ")", "")
            For lngPunkt = 1 To .Points.Count
                .Points(lngPunkt).DataLabel.Text = Range(strFormel).Cells(lngPunkt).Offset(0, - _
9).Value
                .Points(lngPunkt).Format.Line.Visible = msoFalse
                If Range(strFormel).Cells(lngPunkt).Offset(0, -9) <> "" Then
                    With .Points(lngPunkt).Format.Line
                        .Visible = msoTrue
                        .ForeColor.RGB = RGB(0, 0, 0)
                        .Weight = 1.5
                        .Transparency = 0
                    End With
                End If
            Next lngPunkt
        End With
        Set serReihe = Nothing
    End With
End Sub
Sub Prozent80()
    Dim lngPunkt As Long
    Dim serReihe As Series
    Dim strFormel As String
    With ActiveSheet.ChartObjects(1).Chart
        Set serReihe = .SeriesCollection(1)
        With serReihe
            If .HasDataLabels = True Then .DataLabels.Delete
            .ApplyDataLabels
            ' Schrift - Werte entsprechend anpassen
            With serReihe.DataLabels.Font
                .Name = "Arial"
                .Size = 10
                .Color = 255
            End With
            strFormel = Application.Substitute(Split(.Formula, ",")(4), ")", "")
            For lngPunkt = 1 To .Points.Count
                .Points(lngPunkt).DataLabel.Text = Range(strFormel).Cells(lngPunkt).Offset(0, - _
8).Value
                .Points(lngPunkt).Format.Line.Visible = msoFalse
                If Range(strFormel).Cells(lngPunkt).Offset(0, -10) <= Range("D1") Then
                    With .Points(lngPunkt).Format.Line
                        .Visible = msoTrue
                        .ForeColor.RGB = RGB(0, 0, 0)
                        .Weight = 1.5
                        .Transparency = 0
                    End With
                End If
            Next lngPunkt
        End With
        Set serReihe = Nothing
    End With
End Sub

Der Code stellt aus der Datenreihenformel den Zellbereich fest, in dem die Blasengrößen stehen (Spalte L). Davon ausgehend vergleicht er in der Schleife, ob in der Spalte C (bei Top 3) in der laufenden Zeile ein Wert steht, bzw. (bei 80%) der Wert in Spalte B kleiner-gleich dem Wert in D1 ist (so wie deine Formel in Spalte D). Auf dieser Basis wird dann entschieden, ob der Rahmen gesetzt wird oder nicht.
Bezüglich der Färbung nach Marken:
Sub MarkeFaerben()
    Dim arrFarben()
    Dim strFarbe As String
    Dim bytFarbe As Byte
    Dim lngPunkt As Long
    Dim serReihe As Series
    Dim strFormel As String
    Dim pktPunkt As Point
    arrFarben = Array(Array("Adidas", "Puma", "Nike"), Array(255, 15773696, 5296274))
    With ActiveSheet.ChartObjects(1).Chart
        Set serReihe = .SeriesCollection(1)
        With serReihe
            strFormel = Application.Substitute(Split(.Formula, ",")(4), ")", "")
            For lngPunkt = 1 To .Points.Count
                If Range(strFormel).Cells(lngPunkt) <> "" Then
                    strFarbe = Range(strFormel).Cells(lngPunkt).Offset(0, -4).Value
                    bytFarbe = Application.Match(strFarbe, arrFarben(0), 0)
                    Set pktPunkt = .Points(lngPunkt)
                    pktPunkt.Interior.Color = arrFarben(1)(bytFarbe - 1)
                End If
            Next lngPunkt
        End With
        Set serReihe = Nothing
        Set pktPunkt = Nothing
    End With
End Sub

Es muss allerdings garantiert sein, dass alle Marken, die in Spalte H aufgeführt sind und die dazügehörigen Farben im Array enthalten sind. Das Array lässt sich selbstverständlich entsprechend erweitern.
Alles komplett wieder zurücksetzen kannst du dann mit diesem Makro:
Sub AllesZurueck()
    Dim lngPunkt As Long
    Dim serReihe As Series
    With ActiveSheet.ChartObjects(1).Chart
        Set serReihe = .SeriesCollection(1)
        With serReihe
            If .HasDataLabels = True Then .DataLabels.Delete
            For lngPunkt = 1 To .Points.Count
                .Points(lngPunkt).Format.Line.Visible = msoFalse
                With .Points(lngPunkt).Format.Fill
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = msoThemeColorAccent1
                End With
            Next lngPunkt
        End With
        Set serReihe = Nothing
    End With
End Sub

https://www.herber.de/bbs/user/98682.xlsm



Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 07.07.2015 19:29:22
Karin,
mich hat es eben echt umgehauen. Toll! Vielen lieben Dank.
Ich muss zwar noch hinter einiges steigen(auch wenn ich nicht alles genau verstehen werde), aber eines zählt: es funktioniert.
Es kann sein dass ich Dich nochmal fragen muss. Ich werde es morgen dann im Büro in die große Datei implementieren.
-Ich habe dort noch mehr Marken (6) P.s. Du glaubst gar nicht was die Einfärbung erleichert. Man kann das Bild viel schneller interpretieren und für unterschdl. Kriterien (zum Beispiel Produktart: Werte mir alle T-Shirts, Hosen etc. aus) sofort erkennen wer wo "spielt"=.
Das ist sehr Management like - die Chefs wirds freuen.
- Mehr Filter (5-6)
Ich hoffe, ich kriege es implementiert.
Liebe Grüße
Marc

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 07.07.2015 20:25:24
Es muss allerdings garantiert sein, dass alle Marken, die in Spalte H aufgeführt sind und die dazügehörigen Farben im Array enthalten sind. Das Array lässt sich selbstverständlich entsprechend erweitern.
Ich glaube, das ist der höchste Anspruch.
Denn es werden über einen Filter meist ja ganz bewusst nur 2 Marken ausgewertet, oder auch nur 1.
Wenn im Code nun 3 (oder mehr) "fest verdrahtet" sind..wie macht man das dann. Code immer manuell anpassen?
Oder die anderen Marken (sozusagen als all inklusive Liste) immer mit einblenden aber mit 0 Werten (ganz ganz unten am Ende der Liste). Wobei ich über den Filter eigentlich 0 Werte per se raushaue.

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 07.07.2015 20:29:44
Es muss allerdings garantiert sein, dass alle Marken, die in Spalte H aufgeführt sind und die dazügehörigen Farben im Array enthalten sind. Das Array lässt sich selbstverständlich entsprechend erweitern.
Ich glaube, das ist der höchste Anspruch.
Denn es werden über einen Filter meist ja ganz bewusst nur 2 Marken ausgewertet, oder auch nur 1.
Wenn im Code nun 3 (oder mehr) "fest verdrahtet" sind..wie macht man das dann. Code immer manuell anpassen?
Oder die anderen Marken (sozusagen als all inklusive Liste) immer mit einblenden aber mit 0 Werten (ganz ganz unten am Ende der Liste). Wobei ich über den Filter eigentlich 0 Werte per se raushaue.
Anmerkung NEU: ich habe gerade getestet: solange ich die Marken alle in H lasse, kann ich auch nur 2 Filtern und die Färbung funktioniert. Denn die versteckte Marke ist ja noch enthalten.
Also müsste obige Idee laufen....

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 07.07.2015 20:39:23
Es muss allerdings garantiert sein, dass alle Marken, die in Spalte H aufgeführt sind und die dazügehörigen Farben im Array enthalten sind. Das Array lässt sich selbstverständlich entsprechend erweitern.
Ich glaube, das ist der höchste Anspruch.
Denn es werden über einen Filter meist ja ganz bewusst nur 2 Marken ausgewertet, oder auch nur 1.
Wenn im Code nun 3 (oder mehr) "fest verdrahtet" sind..wie macht man das dann. Code immer manuell anpassen?
Oder die anderen Marken (sozusagen als all inklusive Liste) immer mit einblenden aber mit 0 Werten (ganz ganz unten am Ende der Liste). Wobei ich über den Filter eigentlich 0 Werte per se raushaue.

Anmerkung NEU:
ich habe gerade getestet: solange ich die Marken alle in H lasse, kann ich auch nur 2 Filtern und die Färbung funktioniert. Denn die versteckte Marke ist ja noch enthalten.
Also müsste obige Idee laufen....
Noch eine Frage: Array erweitern, heisst im Code Semikolon setzen und weitere Marken hinzufügen.
Muss ich noch den Datenbereich auf den das Anwendung findet erweitern oder erkennt er diesen so?
Der Code stellt aus der Datenreihenformel den Zellbereich fest, in dem die Blasengrößen stehen (Spalte L). Davon ausgehend vergleicht er in der Schleife, ob in der Spalte C (bei Top 3) in der laufenden Zeile ein Wert steht, bzw. (bei 80%) der Wert in Spalte B kleiner-gleich dem Wert in D1 ist (so wie deine Formel in Spalte D). Auf dieser Basis wird dann entschieden, ob der Rahmen gesetzt wird oder nicht.

Das habe ich verstanden vom Prinzip her.
Ich muss das dann auf die anderen Filter anwenden.
Muss ich etwas beachten, wenn ich mehrere Tausend Zeilen habe oder erkennt er den Datenbereich automatisch?

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Beverly
Geschrieben am: 07.07.2015 20:52:45
Hi Marc,
- im Array müssen ALLE vorkommenden Marken und ihre Farbe VORHANDEN sein - ob sie dann benötigt werden ist eine ganz andere Sache.
- der Datenbereich wird aus der Datenreihenformel extrahiert, also wird er automatisch erkannt.




Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 07.07.2015 21:37:01
Hi Karin,
okay. Dann mache ich das so mit den Hilfszellen (alle Namen, alle Farben), die dann in der Auswertung nicht angezeigt werden.
Bin schon ganz auf morgen gespannt.
Schönen Abend noch und viele Grüße
Marc

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 11.07.2015 09:27:54
Guten morgen karin.
ich wollte natürlich noch eine rückmeldung geben.
gestern habe ich alles recht schnell umsetzen koennen und was soll ich sagen:
Es funktioniert einwandfrei, auch mit grösseren Datensätzen und 3D kugeln schafft es das färbe makro!
also herzlichen dank nochmal, das ist echt eine tolle sache!
habe mir die entsprechend.wunschfarbcodes rausgesucht und alle marken die moeglich sind in der gleichen spalte "versteckt.
Auch das "Alles zurueck" makro habe ich aufgeteilt in farbe u.beschriftung zurück und beschriftung zurzeit (aber einfaerbung belassen).
Erweiterungen:
Wie kann ich denn die beschriftung zentrieren? - sie sitzt standardmäßig rechts vom objekt.
Wie kann ich denn -optional- das farbmakro nach filteranwahl (datenschnitte)
automatisch laufen lassen, ohne schaltfläche.
VG Marc

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Beverly
Geschrieben am: 11.07.2015 11:00:42
Hi Marc,
Datenbeschriftung zentrieren: ergänz in allen relevanten Codes die unterste Zeile

            If .HasDataLabels = True Then .DataLabels.Delete
            .ApplyDataLabels
            .DataLabels.Position = xlLabelPositionCenter

Automatischer Ablauf: was verstehst du unter "filterauswahl (datenschnitte)"?
Noch eine Bitte am Rande: da die Forumsbenutzer Menschen sind, wäre es sehr hilfreich, wenn in den Beiträgen die im Deutschen übliche Groß- und Kleinschreibung verwendet würde, da die Beiträge für Menschen so besser lesbar sind - schließlich sind wir keine Computer, denen das gleichgültig ist, weil sie sowieso nur 0 und 1 kennen. ;-))



Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 11.07.2015 11:46:33
Hi nochmal.
Ich dachte ich shreibe eigentlich sehr menschlich wenn auch nicht in gross oder klein;)
Das lag heute mal am Handy.Aber hast recht und ich gelobe Besserung.
Ich filtere die Marken mit einem Datenschnitt denn es steht eine Pivot dahinter.
Es gibt allerdings bestimmt 12 slicer zum Filtern.
Jeder veraendert die Datenrange und damit das Dia.
Ich muss nochmal testen aber ich hatte gedacht ich muss bei neuer Auswahl das Farbmakro neu starten.
Damit sicher auch alle neuen Blasen richtig eingefärbt sind.
Daher meine Frage.
Ich teste es aber wie gesagt nochmal.Jetzt wo ich drüber nachdenke geht es vlt. doch wenn das Makro einmal aktiviert wurde.
VG Marc

Bild

Betrifft: AW: Farben Blasen-Diagramm
von: Marc
Geschrieben am: 11.07.2015 09:32:58
Guten morgen karin.
ich wollte natürlich noch eine rückmeldung geben.
gestern habe ich alles recht schnell umsetzen koennen und was soll ich sagen:
Es funktioniert einwandfrei, auch mit grösseren Datensätzen und 3D kugeln schafft es das färbe makro!
also herzlichen dank nochmal, das ist echt eine tolle sache!
habe mir die entsprechend.wunschfarbcodes rausgesucht und alle marken die moeglich sind in der gleichen spalte "versteckt.
Auch das "Alles zurueck" makro habe ich aufgeteilt in farbe u.beschriftung zurück und beschriftung zurzeit (aber einfaerbung belassen).
Erweiterungen:
Wie kann ich denn die beschriftung zentrieren? - sie sitzt standardmäßig rechts vom objekt.
Wie kann ich denn -optional- das farbmakro nach filteranwahl (datenschnitte)
automatisch laufen lassen, ohne schaltfläche.
VG Marc

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Farben Blasen-Diagramm"