Hallo Jacques,
leider gibt es in Excel keine Möglichkeit ein Blasendiagramm mit den Standardeinstellungen automatisch in der von dir gewünschten Form darstellen zu lassen.
Man muss manuell jede Datenreihe (je Lieferant) einzeln über „Daten auswählen“ zum Diagramm hinzufügen oder das Ganze von einem Makro erledigen lassen.
Nachfolgend ein Makro aus meinem Bestand zur Erstellung eines Blasendiagramm für viele benamte Datenreihen. Einzelne Festlegungen imMakro muss du ggf anpassen.
Gruß
Franz
Beispieldaten
Tabellenblattname: Tabelle1
A B C D
1 Lieferant Bestellungen Durchschnitt Anteil
2 A 50 969,36 0,06%
3 B 12 919,93 0,06%
4 C 126 10812,00 0,71%
5 D 10 7156,59 0,47%
6 E 98 10057,67 0,66%
Makro:
Sub Blasendiagramm\_Erstellen()
'Erstellt auf Basis selektierter Zellen ein Blasendiagramm.
'Daten der Datenreihen müssen dabei in Zeilen angeordnet sein.
Dim rngData As Range
Dim objChart As Chart, objReihe As Series, intReihe As Integer
Dim objAxis As Axis, objDatalabels As DataLabels
Dim wks As Worksheet
Dim lngZeile As Long, lngSpalte As Long
Const strMsgTitel As String = "Blasendiagramm erstellen"
On Error GoTo Fehler
Set wks = ActiveSheet
Set rngData = Selection
Set rngData = Application.InputBox(Prompt:="Bitte Datenbereich des Diagramms " \_
& "selektieren, inkl. Reihennamen und Achsentitel", \_
Title:=strMsgTitel, \_
Default:=rngData.Address(ReferenceStyle:=xlA1), \_
Type:=8)
With rngData
If .Columns.Count 4 Then
MsgBox "Selektierter Bereich für Diagramm muss 4 Spalten haben!", vbInformation, strMsgTitel
GoTo Fehler
End If
If .Columns.Count .SeriesCollection.Count Then
.SeriesCollection.NewSeries
End If
Set objReihe = .SeriesCollection(intReihe)
With objReihe
.FormulaR1C1 = "=SERIES('" & wks.Name & "'!R" & lngZeile & "C" & lngSpalte & ",'" \_
& wks.Name & "'!R" & lngZeile & "C" & lngSpalte + 1 & ":R" & lngZeile & "C" & lngSpalte + 1 & ",'" \_
& wks.Name & "'!R" & lngZeile & "C" & lngSpalte + 2 & ":R" & lngZeile & "C" & lngSpalte + 2 & "," \_
& intReihe & ",'" \_
& wks.Name & "'!R" & lngZeile & "C" & lngSpalte + 3 & ":R" & lngZeile & "C" & lngSpalte + 3 & ")"
'Füllfarbe der Blasen für Reihe aus Zelle übernehmen
'Wenn in Spalte neben den Daten die Zellen gefärbt sind, dann werden die Farben für die \_
Diagrammreihen übernommen
If rngData.Cells(lngZeile, lngSpalte + 4).Interior.ColorIndex xlColorIndexNone Then
.Format.Fill.ForeColor.RGB = rngData.Cells(lngZeile, lngSpalte + 4).Interior.Color
End If
'Linie um Blasen
With .Format.Line
.DashStyle = msoLineSolid
.Weight = 1
.BackColor.RGB = RGB(255, 255, 255)
.Visible = msoTrue
End With
'Beschrifung der Datenreihe
.ApplyDataLabels Type:=xlDataLabelsShowBubbleSizes, LegendKey:=False, ShowSeriesName:=False, \_
ShowCategoryName:=False, ShowValue:=False, Separator:=vbLf
With .DataLabels
.Position = xlLabelPositionCenter
With .Format.TextFrame2.TextRange.Font
.Name = "Arial"
.Italic = True
.Size = 10
End With
End With
End With
Next
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 13 '
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf \_
& "Bitte vor Makrostart eine Zelle bzw. den Datenbereich für's Diagramm selektieren", \_
vbInformation, strMsgTitel
Case 424 'Bereichsauswahl für Diagrammwerte wurde abgebrochen
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, \_
vbInformation, strMsgTitel
End Select
End With
Set wks = Nothing: Set rngData = Nothing
Set objChart = Nothing: Set objReihe = Nothing
End Sub
