Punktdiagramm xy mit VBA erstellen
04.06.2013 20:25:08
Rainer
ich habe folgendes Problem / folgende Aufgabenstellung:
Es muss aus vielen Messergebnissen welche jeweils aus X-Werten und den dazugehörigen Y-Werten bestehen, ein Punktediagramm mit vielen Datenreihen erstellen. Die Werte stehen immer in einer Spalte untereinander und der dazugehörige Wert steht ebenfalls untereinander in einer nebenstehenden Spalte. Da jede der 200 Datenreihen aus ca. 200 Messpunkten besteht, ist eine manuelle Eingabe sehr zeitaufwendig.
Details:
Datensatz 1:
Datenüberschrift: A2:B2 (verbundene Zelle)
X-Werte: A6:A220
Y-Werte: B6:B220
Datensatz 2:
Datenüberschrift: C2:D2 (verbundene Zelle)
X-Werte: C6:C220
Y-Werte: D6:D220
...
Da es zu viele Spalten für ein Tabellenblatt sind, wird die Tabelle auf einem zweiten Tabellenblatt fortgeführt.
Wie könnte ein Makro aussehen, das dieses Diagramm automatisch generiert?
Habe es mit einem teiweise manuellen Makro versucht - leider funktioniert dies nicht.
Vielen Dank für eure Hilfe!
Gruß,
Rainer
Sub M_Diagramm()
Sheets("Kurvenwerte 1").Select
Charts.Add
ActiveChart.ChartType = xlXYScatterSmooth
ActiveChart.SetSourceData Source:=Sheets("Kurvenwerte 1").Range("C252")
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = "='Kurvenwerte 1'!R6C1:R220C1"
ActiveChart.SeriesCollection(1).Values = "='Kurvenwerte 1'!R6C2:R220C2"
ActiveChart.SeriesCollection(1).Name = "='Kurvenwerte 1'!R2C1:R2C2"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).XValues = "='Kurvenwerte 1'!R6C3:R220C3"
ActiveChart.SeriesCollection(2).Values = "='Kurvenwerte 1'!R6C4:R220C4"
ActiveChart.SeriesCollection(2).Name = "='Kurvenwerte 1'!R2C3:R2C4"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).XValues = "='Kurvenwerte 1'!R6C5:R220C5"
ActiveChart.SeriesCollection(3).Values = "='Kurvenwerte 1'!R6C6:R220C6"
ActiveChart.SeriesCollection(3).Name = "='Kurvenwerte 1 !R2C5:R2C6"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).XValues = "='Kurvenwerte 1'!R6C7:R220C7"
ActiveChart.SeriesCollection(4).Values = "='Kurvenwerte 1'!R6C8:R220C8"
ActiveChart.SeriesCollection(4).Name = "='Kurvenwerte 1 !R2C7:R2C8"
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="RL Diagramm"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "RL-Diagramm"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Distance [mm]"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Force [kN]"
End With
Charts.Add
End Sub