Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1752to1756
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

Kreisdiagramm

Kreisdiagramm
30.04.2020 14:23:21
Scalli
Guten Tag zusammen
Ich hoffe ihr könt mir einen kleinen Tipp geben für mein Problem.
Also:
Ich habe eine kleine Tabelle à zwei Zeilen und 7 Spalten. In der ersten Zeile stehen die Titel und in der zweiten Zahlenwerte von 0 bis max. 20. Könnte so z.b aussehen:
Titel a Titel b Titel c Titel d Titel e Titel f Titel g
0 2 0 5 11 0 3
Nun würde ich gerne mit einem Makro davon ein Kreisdiagramm erstellen. Dies habe ich mit dem Aufzeicher auch hinbekommen, siehe Code unten:
Sub test1kreisdiagramm()
' test1kreisdiagramm Makro
Range("D3:J4").Select
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.SetSourceData Source:=Range("Tabelle1!$D$3:$J$4")
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 259
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 260
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 259
End Sub
(Ich switche in den Styles umher, da ich gerne die Prozentangabe im Diagramm haben möchte und bisher nur diesen weg gefunden habe.)
Nun zum Problem:
Wenn in der Tabelle Werte mit "0" vorhanden sind werden diese zwar nicht aufgezeichnet aber im Diagramm entsteht ein Kästchen mit dem Titel und der Prozentangabe 0%. Das ist zwar schön und gut aber es stört in der Optik. Gibt es eine möglichkeit die "Nullen" in der Grafik zu deaktivieren? Am besten wäre es glaube ich wenn ich dem Kreisdiagramm sagen könnte; " erstelle nur eine Grafik mit den Titeln und Werten die grösser als 0 sind."
Ich hoffe das Problem ist verständlich beschrieben. Hat da jemand eine Idee?

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kreisdiagramm
30.04.2020 15:59:35
Beverly
Hi,
in dem Fall musst du den Datenbereich mittels Schleife zusammensetzen, indem du prüfst, ob die Zelle einen Wert > 0 enthält:
Sub test1kreisdiagramm()
Dim intSpalte As Integer
Dim rngBereich As Range
With ActiveSheet.Shapes.AddChart2(251, xlPie).Chart
If .SeriesCollection.Count > 0 Then
For intSpalte = .SeriesCollection.Count To 1 Step -1
.SeriesCollection(intSpalte).Delete
Next intSpalte
End If
For intSpalte = 4 To 10
If Cells(4, intSpalte) > 0 Then
If rngBereich Is Nothing Then
Set rngBereich = Range(Cells(3, intSpalte), Cells(4, intSpalte))
Else
Set rngBereich = Union(rngBereich, Range(Cells(3, intSpalte), Cells(4,  _
intSpalte)))
End If
End If
Next intSpalte
.SetSourceData Source:=rngBereich
.FullSeriesCollection(1).ApplyDataLabels
With .FullSeriesCollection(1).DataLabels
.ShowPercentage = True
.ShowCategoryName = True
.ShowValue = False
.Position = xlLabelPositionOutsideEnd
End With
.HasLegend = False
End With
End Sub

Du musst aber bedenken, dass die übersprungen Zellen nicht im Diagramm "auftauchen" werden, sobald du den Wert von 0 auf einen positiven Wert änderst.


Anzeige
AW: Kreisdiagramm
30.04.2020 16:28:37
Scalli
Hi Beverly,
Vielen lieben Dank für deine Antwort! Das klappt super!
Ich vermute mal wenn ich die Werte von 0 auf positive umändere, muss ich einfach ein neues Diagramm erstellen. Ich müsste also eine Schleife einbauen, die das aktuelle Diagramm löscht und dann ein neues generiert. Sehe ich das so richtig?
AW: Kreisdiagramm
30.04.2020 17:49:53
Beverly
Hi,
ich würde es generell anders machen: ab Excel2013 ist es ja möglich, den Beschriftungslabels auch einen Zellbereich zuzuweisen. Deshalb würde ich in einem extra Zellbereich die Beschriftung aus der Titel-Zeile und den Werten (umgerechnet in %) zusammensetzen - hier D6:J6

Tabelle1
 DEFGHIJ
2       
3Titel1Titel2Titel3Titel4Titel5Titel6Titel7
45045056
5       
6Titel1;
20%
 Titel3;
16%
Titel4;
20%
 Titel6;
20%
Titel7;
24%
7       

verwendete Formeln
Zelle Formel Bereich N/A
D6:J6=WENN(D4>0;D3&";"&ZEICHEN(10)&RUNDEN(D4/SUMME($D4:$J4)*100;0)&"%";"")  


Diesen Zellbereich kann man dann als Beschriftung zuweisen
Sub Kreisdiagramm2()
Dim intSpalte As Integer
Dim rngBereich As Range
Dim chrDia
If ActiveSheet.ChartObjects.Count = 1 Then
For Each chrDia In ActiveSheet.ChartObjects
If chrDia.Chart.ChartType = xlPie Then Exit For
Next chrDia
Else
Set chrDia = ActiveSheet.Shapes.AddChart2(251, xlPie)
With chrDia.Chart
.SetSourceData Source:=Range("D3:J4")
.FullSeriesCollection(1).ApplyDataLabels
With .FullSeriesCollection(1).DataLabels
.Position = xlLabelPositionOutsideEnd
.ShowValue = False
.ShowRange = True
.Format.TextFrame2.TextRange. _
InsertChartField msoChartFieldRange, "Tabelle1!D6:J6"
End With
.HasLegend = False
End With
End Sub


Anzeige
AW: Kreisdiagramm
30.04.2020 23:15:57
Scalli
Perfekt! Ich hatte schon mal die Idee mit einer wenn funktion zu arbeiten aber es dann in ein Diagramm zu transferieren überstieg meine Kentnisse.
Vielen lieben Dank für deine Mühen, es klappt bestens. Habe gerade richtig fest Freude daran :)
AW: Kreisdiagramm
02.05.2020 15:58:48
Scalli
Hi Beverly
Ich hätte doch noch eine kurze Frage und zwar würde ich gerne mit dem makro nicht nur ein Kuchendiagramm erstellen sondern 2. Ich habe für beide diagramme den gleichen code verwendet und einfach die Quellen angepasst. Dies funktioniert auch ganz ok. Nur muss ich aufpassen welches makro ich zuerst auslöse aufgrund des Count Befehls am anfang. Nun würde ich die zwei codes gern zusammenfügen. Ich vermute mal das ist einfacher gesagt als getan?
Hier mal der eine Code

Sub Kuchendiagramm2()
Dim intSpalte As Integer
Dim rngBereich As Range
Dim chrDia
If ActiveSheet.ChartObjects.Count = 2 Then
For Each chrDia In ActiveSheet.ChartObjects
If chrDia.Chart.ChartType = xlPie Then Exit For
Next chrDia
Else
Set chrDia = ActiveSheet.Shapes.AddChart2(251, xlPie)
With chrDia
.IncrementLeft -385.5294488189
.Height = 374.1732283465
.Width = 581.1023622047
End With
End If
With chrDia.Chart
.SetSourceData Source:=Range("M12:V13")
.FullSeriesCollection(1).ApplyDataLabels
With .FullSeriesCollection(1).DataLabels
.Position = xlLabelPositionOutsideEnd
.ShowValue = False
.ShowRange = True
.Format.TextFrame2.TextRange. _
InsertChartField msoChartFieldRange, ActiveSheet.Name & "!M15:V15"
End With
.HasLegend = False
.SetElement (msoElementChartTitleAboveChart)
.ChartTitle.Text = "Anmelde-Problematik"
.ChartTitle.Format.TextFrame2.TextRange.Font.Name = "Arial"
.ChartTitle.Format.TextFrame2.TextRange.Font.Bold = True
.ChartTitle.Format.TextFrame2.TextRange.Font.Size = 16
.ChartArea.Top = 366
End With
End Sub

Der zweite code ist genau gleich aufgebaut ausser dass die Source anders ist und die verschiebungen am anfang anders sind.
Anzeige
2 Diagramme erstellen
02.05.2020 19:53:18
Beverly
Hi,
es gibt verschiedene Möglichkeiten - du kannst z.B. die vorhandenen Diagramme zu Beginn löschen und beide neu erstellen:
Sub Dias2Erstellen()
Dim intSpalte As Integer
Dim rngBereich As Range
Dim chrDia
If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete
Set chrDia = ActiveSheet.Shapes.AddChart2(251, xlPie)
With chrDia
.IncrementLeft -385.5294488189
.Height = 374.1732283465
.Width = 581.1023622047
With .Chart
.SetSourceData Source:=Range("M12:V13")
.FullSeriesCollection(1).ApplyDataLabels
With .FullSeriesCollection(1).DataLabels
.Position = xlLabelPositionOutsideEnd
.ShowValue = False
.ShowRange = True
.Format.TextFrame2.TextRange. _
InsertChartField msoChartFieldRange, ActiveSheet.Name & "!M15:V15"
End With
.HasLegend = False
.SetElement (msoElementChartTitleAboveChart)
.ChartTitle.Text = "Anmelde-Problematik"
.ChartTitle.Format.TextFrame2.TextRange.Font.Name = "Arial"
.ChartTitle.Format.TextFrame2.TextRange.Font.Bold = True
.ChartTitle.Format.TextFrame2.TextRange.Font.Size = 16
.ChartArea.Top = 366
End With
End With
Set chrDia = ActiveSheet.Shapes.AddChart2(251, xlPie) '


Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige