AW: Blasendiagramm
13.11.2006 16:36:50
fcs
Hallo Katja,
da der Assistent das nicht auf die Reihe bringt, habe ich mir nachfolgendes Makro geschrieben, das jede Zeile als eigene Datenreihe erstellt.
Beispieldaten:
Name x y Größe
A 2 1 4
B 4 5 12
C 6 9 3
D 8 13 22
Diese Daten markieren, dann das Makro starten.
Das Makro kopierst du im VBA-Editor am besten in ein Modul deiner persönlichen Makro-Arbeitsmappe. Hoffe das kriegst du ohne große VBA-Kenntnisse hin.
Gruß
Franz
Sub Blasendiagramm_mit_Reihe_je_Zeile()
' Erzeugt aus selektierten Daten ein Blasendiagramm mit einer Reihe pro Zeile
' Selektion muss beinhalten:
' 1. Zeile Spalten-Überschriften (werden für Diagrammbeschriftung vorgeschlagen)
' 1. Spalte Kategorien (Beschriftung für Legende, je Kategorie wird eine Datenreihe erzeugt
' 2. Spalte X-Werte
' 3. Spalte Y-Werte
' 4. Spalte Blasengröße
Dim Daten As Range, wks As Worksheet, Reihe As Series
Set wks = ActiveSheet
Set Daten = Selection
Charts.Add
ActiveChart.ApplyCustomType ChartType:=xlBubble
ActiveChart.Location Where:=xlLocationAsNewSheet
With wks
ActiveChart.SetSourceData Source:=.Range(.Cells(Daten.Row + 1, Daten.Column), _
.Cells(Daten.Row + Daten.Rows.Count - 1, Daten.Column + 3)), PlotBy:=xlRows
End With
Application.ScreenUpdating = False
For i = ActiveChart.SeriesCollection.Count To 2 Step -1
ActiveChart.SeriesCollection(i).Delete
Next
For i = 1 To Daten.Rows.Count - 1
Set Reihe = ActiveChart.SeriesCollection(i)
With Reihe
.Name = "=" & wks.Name & "!R" & Daten.Row + i & "C" & Daten.Column
.XValues = "=" & wks.Name & "!R" & Daten.Row + i & "C" & Daten.Column + 1
.Values = "=" & wks.Name & "!R" & Daten.Row + i & "C" & Daten.Column + 2
.BubbleSizes = "=" & wks.Name & "!R" & Daten.Row + i & "C" & Daten.Column + 3
.ApplyDataLabels Type:=xlDataLabelsShowBubbleSizes 'Wert Blasengröße wird angezeigt
End With
If i <> Daten.Rows.Count - 1 Then
ActiveChart.SeriesCollection.NewSeries
End If
Next
Application.ScreenUpdating = True
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = InputBox("Diagrammtitel", "Neues Diagramm", Daten(1, 4))
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = InputBox("Beschriftung X-Achse:", "Neues Diagramm", Daten(1, 2))
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = InputBox("Beschriftung Y-Achse:", "Neues Diagramm", Daten(1, 3))
End With
End Sub