Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

XY Diagramme aus 2 Tabellenblättern VBA

XY Diagramme aus 2 Tabellenblättern VBA
09.01.2019 11:52:22
Alex
Userbild
Hallo,
ich suche ein Makro, dass mir aus einer Tabelle Diagramme automatisch erstellt. Die Datei besteht aus 2 Tabellenblättern, die identisch aufgebaut sind, jedoch einmal mit bereinigten und unbereinigten Messwerten versehen sind.
Eine Testdatei ist im Anhang (bzw ein Bild, wie es sein soll).
Nun will ich auf einem drittem Tabellenblatt (Diagramme) mir zu jedem Messwert ein Diagramm zeigen lassen.
Auf der X-Achse soll das Datum stehen, auf der Y-Achse die Messwerte.
Jedes Diagramm soll 2 Kurven haben. Einmal die unbereinigten Werte aus Blatt 1 und einmal die bereinigten aus Blatt 2.
Also: Diagramm n: X:Achse: Datum, Y-Achse: Wert(n) bereinigt // Wert (n) unbereinigt
Ich habe mich mal mit dem Makro Rekorder versucht, allerdings entstehen dabei Fehlermeldungen oder es funktioniert nicht richtig.
Anbei der Code. Ich habe mir überlegt, die Werte erst rüber zukopieren, das Diagramm dann damit zu erstellen.
Allerdings übernimmt er nur 1 Diagramm und der ganze Weg dahin ist ein ziemliches Gefummel, da ich einige Makros mehrmals ausführen muss.
Für etwaige Lösungsvorschläge bin ich sehr dankbar.
Sub Datum_kopieren()
' Datum_kopieren Makro Hinweis: Blatt mit Namen "Hilfswerte Diagramme" erstellen
Range("A11").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Hilfswerte Diagramme").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Sub werte_kopieren()
' werte_kopieren Makro HINWEIS: B1 Im Blatt Hilfswerte auswählen, ersten Startwert im  _
Tabellenblatt markieren
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Hilfswerte Diagramme").Select
ActiveSheet.Paste
Sheets("Werte bereinigt").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Hilfswerte Diagramme").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Werte bereinigt").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Sheets("Werte unbereinigt").Select
ActiveCell.Offset(0, 1).Range("A1").Select
End Sub

Sub verschieben()
'
' verschieben Makro
'
'
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(0, -3).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveCell.Offset(0, 3).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 3).Range("A1").Select
End Sub

Sub Diagramm()
'
' Diagramm Makro
'
'
ActiveCell.Range("A1:C1").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
ActiveChart.SetSourceData Source:=Range( _
"'Hilfswerte Diagramme'!$A$1:$C$105408")
ActiveChart.Parent.Cut
Sheets("Diagramme").Select
ActiveSheet.Paste
Sheets("Hilfswerte Diagramme").Select
ActiveCell.Offset(0, 3).Range("A1").Select
End Sub

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: XY Diagramme aus 2 Tabellenblättern VBA
09.01.2019 14:35:50
Daniel
Hallo Alex,
bin selber noch am Lernen, insofern gibt es sicher elegantere und bessere Lösungen für dein Problem. Allerdings sollte dieser Code funktionieren. Eventuell müsstest du dann noch die Darstellung und Größe der Diagramme entsprechend deinen Bedürfnissen anpassen.
Gruß
Daniel
Sub Diagramme()
Dim ws As Worksheet, WsDiagramm As Worksheet, WsExists As Boolean
Dim Messwerte As Integer, AktChart As Chart, Top As Integer
'Pruefen, ob Abeitsblatt schon existiert, ansonsten anlegen
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Diagramme" Then
Set WsDiagramm = ws
WsExists = True
End If
Next ws
If WsExists = False Then
Set WsDiagramm = Sheets.Add(after:=Sheets("Werte bereinigt"))
WsDiagramm.Name = "Diagramme"
End If
'Diagramme erstellen pro Messwert
For Messwerte = 1 To 3
Set AktChart = WsDiagramm.Shapes.AddChart2(227, xlLine, 1, Top, , 200).Chart
With AktChart
.ChartTitle.Text = "Messwert " & Messwerte
.SeriesCollection.NewSeries
.FullSeriesCollection(1).XValues = Sheets("Werte unbereinigt").Range("$A$11:$A$41")
.FullSeriesCollection(1).Name = "Werte unbereinigt"
.FullSeriesCollection(1).Values = Sheets("Werte unbereinigt").Range("$C$11:$C$41").Offset( _
0, Messwerte - 1)
.SeriesCollection.NewSeries
.FullSeriesCollection(2).Name = "Werte bereinigt"
.FullSeriesCollection(2).Values = Sheets("Werte bereinigt").Range("$C$11:$C$41").Offset(0, _
Messwerte - 1)
End With
Top = Top + 210
Next Messwerte
End Sub

Anzeige
AW: XY Diagramme aus 2 Tabellenblättern VBA
09.01.2019 22:11:04
Alex
Hallo Daniel,
danke für deine Zeit.
Leider bekomme ich in Zeile
.FullSeriesCollection(1).XValues = Sheets("Werte unbereinigt").Range("$A$11:$A$41")
einen Fehler "Methode oder Datenobjekt nicht gefunden".
Die erste Zeile

Sub Diagramme wird dabei gelb angezeigt.
Ich hab mal etwas dazu gegoogelt und anscheinend kann Excel 2010 den Befehl noch nicht  _
verarbeiten, sondern nur "SeriesCollection"
Bekomme aber wieder eine Fehlermeldung "Laufzeitfehler 91" : Blockvariable oder with- _
Blockvariable nicht festgelegt".
So sieht der Code grad aus
'Diagramme erstellen pro Messwert
For Messwerte = 1 To 3
Set AktChart = WsDiagramm.Shapes.AddChart2(227, xlLine, 1, Top, , 200).Chart
With AktChart
.HasTitle = True
.ChartTitle.Text = "Messwert  & Messwerte"
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = Sheets("Werte unbereinigt").Range("$A$11:$A$41")
.SeriesCollection(1).Name = "Werte unbereinigt"
.SeriesCollection(1).Values = Sheets("Werte unbereinigt").Range("$C$11:$C$41").Offset( _
0, Messwerte - 1)
.SeriesCollection.NewSeries
.SeriesCollection(2).Name = "Werte bereinigt"
.SeriesCollection(2).Values = Sheets("Werte bereinigt").Range("$C$11:$C$41").Offset(0, _
Messwerte - 1)
End With
Top = Top + 210
Next Messwerte
End Sub

Zudem ist es möglich die Reichweite auf eine ganze Spalte einzustellen, sodass da zB. steht
.SeriesCollection(1).XValues = Sheets("Werte unbereinigt").Range("Spalte A")? (Also ab A11 die komplette spalte)
Gruß Alex
Anzeige
AW: XY Diagramme aus 2 Tabellenblättern VBA
09.01.2019 22:16:32
Alex
Musste noch den Haken fürs offenhalten setzen.
Gruß Alex
AW: XY Diagramme aus 2 Tabellenblättern VBA
10.01.2019 08:26:43
Daniel
Mit Excel 2010 kann ich dir leider nicht helfen, bin erst bei der aktuellen Version eingestiegen. Da gibt es aber bestimmt erfahrene Experten hier, die sich mit älteren Excel Versionen auskennen?
Eine ganze Spalte kannst du auswählen, indem du Range("A:A") benutzt. Oder in deinem Fall nur ab Zeile 11: Range("A11:A").
Viel Erfolg!
AW: XY Diagramme aus 2 Tabellenblättern VBA
10.01.2019 09:31:28
Alex
Hallo Daniel,
ich danke dir für deine Zeit und für den Tipp mit der Spalte.
Der Übersicht halber packe ich meinen aktuellen Code nochmal hier rein.
Die Fehlermeldung lautet immernoch
"Laufzeitfehler 91" : Blockvariable oder with- lockvariable nicht festgelegt".
Sub Diagramme()
Dim ws As Worksheet, WsDiagramm As Worksheet, WsExists As Boolean
Dim Messwerte As Integer, AktChart As Chart, Top As Integer
'Pruefen, ob Abeitsblatt schon existiert, ansonsten anlegen
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Diagramme" Then
Set WsDiagramm = ws
WsExists = True
End If
Next ws
If WsExists = False Then
Set WsDiagramm = Sheets.Add(after:=Sheets("Werte bereinigt"))
WsDiagramm.Name = "Diagramme"
End If
'Diagramme erstellen pro Messwert
For Messwerte = 1 To 3
Set AktChart = WsDiagramm.Shapes.AddChart2(227, xlLine, 1, Top, , 200).Chart
With AktChart
.HasTitle = True
.ChartTitle.Text = "Messwert  & Messwerte"
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = Sheets("Werte unbereinigt").Range("$A$11:$A$")
.SeriesCollection(1).Name = "Werte unbereinigt"
.SeriesCollection(1).Values = Sheets("Werte unbereinigt").Range("$C$11:$C$").Offset( _
0, Messwerte - 1)
.SeriesCollection.NewSeries
.SeriesCollection(2).Name = "Werte bereinigt"
.SeriesCollection(2).Values = Sheets("Werte bereinigt").Range("$C$11:$C$").Offset(0, _
Messwerte - 1)
End With
Top = Top + 210
Next Messwerte
End Sub
MfG Alex
Anzeige
AW: XY Diagramme aus 2 Tabellenblättern VBA
12.01.2019 01:23:19
Piet
Hallo Alex
ich weiss nicht ob ich den Fehler gefunden habe, prüfe bitte mal den Range Bereich des Sheet("Werte unbereinit")
Ich sehe da: - Range("$A$11:$A$") - beginnt mit Zeile 11 - aber es gibt keine Endzeile!! - Bei drei Bereichen!!
Ich kann es hier nicht prüfen, aber ich glaube ohne Angabe der Endzeile in drei Range wird das nix!
mfg Piet
AW: XY Diagramme aus 2 Tabellenblättern VBA
12.01.2019 01:39:08
Piet
Hallo Alex
ich habe gerade gelesen das du die ganze Spalte auswerten willst. Das sind über 1 Million Zeilen!!
Mein Vorschlag ist, richte dir zwei Variable ein, für Spalte A und Spalte C. Bitte so laden:
lzA = Cells(Rows.Count, 1).End(xlUp).Row
lzC = Cells(Rows.Count, 3).End(xlUp).Row
Dann definiere den Range Bereich mal so: Range("A11:A" & lzA) - dasselbe für Range("C11:C" & lzC)
Würde mich freuen wenn es damit klappt.
mfg Piet
Anzeige
AW: XY Diagramme aus 2 Tabellenblättern VBA
13.01.2019 12:27:47
Alex
Hallo Piet,
leider bekomme ich wieder einen Laufzeitfehler bei
Set AktChart = WsDiagramm.Shapes.AddChart2(227, xlLine, 1, Top, , 200).Chart
Laufzeitfehler 438 - Objekt unterstützt diese Methode nicht.
Liegt das daran, dass der Befehl falsch ist? Ich habe auf Google den hier gefunden und eingesetzt
ActiveChart.ChartType = xlXYScatterSmooth
Ich bekomme da trotzdem noch einen Fehler.
Sub Diagramme()
Dim ws As Worksheet, WsDiagramm As Worksheet, WsExists As Boolean
Dim Messwerte As Integer, AktChart As Chart, Top As Integer
lzA = Cells(Rows.Count, 1).End(xlUp).Row
lzC = Cells(Rows.Count, 3).End(xlUp).Row
'Pruefen, ob Abeitsblatt schon existiert, ansonsten anlegen
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Diagramme" Then
Set WsDiagramm = ws
WsExists = True
End If
Next ws
If WsExists = False Then
Set WsDiagramm = Sheets.Add(after:=Sheets("Werte bereinigt"))
WsDiagramm.Name = "Diagramme"
End If
'Diagramme erstellen pro Messwert
For Messwerte = 1 To 3
Set AktChart = WsDiagramm.Shapes.AddChart2(227, xlLine, 1, Top, , 200).Chart
With AktChart
.HasTitle = True
.ChartTitle.Text = "Messwert  & Messwerte"
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = Sheets("Werte unbereinigt").Range("A11:A&lzA")
.SeriesCollection(1).Name = "Werte unbereinigt"
.SeriesCollection(1).Values = Sheets("Werte unbereinigt").Range("C11:C&lzC").Offset(0,  _
Messwerte - 1)
.SeriesCollection.NewSeries
.SeriesCollection(2).Name = "Werte bereinigt"
.SeriesCollection(2).Values = Sheets("Werte bereinigt").Range("C11:C&lzC").Offset(0,  _
Messwerte - 1)
End With
Top = Top + 210
Next Messwerte
End Sub

Anzeige
AW: XY Diagramme aus 2 Tabellenblättern VBA
13.01.2019 12:33:05
Alex
Habe jetzt noch einen zweiten Versuch gestartet mit einem neuen Code, den ich mir aus Google zusammengebastelt habe.
Dieser kommt meinem Wunschergebnis schon sehr nahe. Allerdings schaffe ich es nicht, die 2. Kurve mit den Werten aus dem anderem Tabellenblatt einzufügen.
Sub DiagrammErstellen()
Dim i, lastrow, X, Y, spalten, cht, l, r
spalten = Array("C", "D", "E", "F", "G", "H")
For i = 0 To UBound(spalten)
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
X = "A2:A" & lastrow
Y = spalten(i) & "2:" & spalten(i) & lastrow
Set cht = ActiveSheet.Shapes.AddChart
cht.Chart.ChartType = xlXYScatter
cht.Chart.SetSourceData Source:=Sheets(1).Range(X & "," & Y)
cht.Chart.SeriesCollection(1).Name = "='" & ActiveSheet.Name & "'!$" & spalten(i) & "$1"
cht.Width = 180   'Breite des Diagramms
cht.Height = 150  'Höhe
If i Mod 2 = 0 Then
cht.Left = Range("O2").Left 'O2 linke obere Ecke der Diagramme aus Spalte B/F/G
cht.Top = Range("O2").Offset(l * 14, 0).Top
l = l + 1
Else
cht.Left = Range("S2").Left 'S2 linke obere Ecke der Diagramme aus Spalte C/G/K
cht.Top = Range("S2").Offset(r * 14, 0).Top
r = r + 1
End If
Next
End Sub

mfg Alex
Anzeige
AW: XY Diagramme aus 2 Tabellenblättern VBA
13.01.2019 19:08:49
Piet
Hallo Alex
anbei eine nachgebaute Beispiel Datei von mir mit einer Makro Lösung zu einem früheren Code.
Den letzten Code habe ich laufen lassen, du siehst ein Ergebnis, mir ist aber unklat ob das gewünscht ist?
Auf der unteren Achse sehe ich die Zahlen 8, 5, 10 statt Datum. Deswegen bin ich in umklaren was du anzeigst?
Im Blatt "Diagramm Test" findest du den Code aus deiner ersten Anfrage, der funktioniert jetzt auch.
Wenn du wissen willst was man bei Range(Selection) richtig bösartig falsch machen kann schau dir bitte deinen eigenen Code aus dem Makro Diagramm im Sheet "Hilfswerte Diagramme" an! Da ging es ums kopieren von Daten aus "Werte unbearbeitet" und "bereinigt".
War auch für mich eine nette amüsante Überraschung als ich diesen Kopiervorgang mit Select rekonstruierte!!
Im Blatt Diagramm findest du den Code von Daniel, den ich aendern muste, weil der Befehl "Shapes.AddChart2" auf meinem PC nicht funktioniert. Kann sein das er erst ab Excel 2010 klappt? Dieses Makro findest du im Modul2_2 und alle Werte, Höhe, Breite, Top und Left auf dem Bildschirm kannst du nach belieben selbst einstellen.
Bei dem neuen Code ist mein Vorschlag durch 2 For Next Schleifen 3+3 zu machen! Drei Diagramme untereinander für bereinigte Werte, daneben die unbereinigten. So kannst du 1:1 vergleichen! Bei diesem System must du den Vergleichswert über Kreuz suchen!
Wenn du mir sagst welche Daten im neuen Code wohin sollen bringen wir den evtl. auch ans Laufen.
Jetzt warte ich erst mal deine Rückmeldung ab.
mfg Piet
https://www.herber.de/bbs/user/126721.xlsm
Anzeige
AW: XY Diagramme aus 2 Tabellenblättern VBA
13.01.2019 21:13:14
Alex
Hallo Piet,
vielen Danke für deine Hilfe. Der Code aus Modul 2_2 funtioniert einwandfrei.
Ich habe jetzt allerdings noch eine Spalte zusätzlich erstellt, in der ich Datum und Uhrzeit addiere und diese an als X-Achse verwende.
Dadurch entgehe ich dem Problem, dass ich pro X wert mehrere Y-Werte habe.
Die Lösung mit den 2 Diagrammen verwerfe ich erstmal, da aufgrund der Datenmenge zwei Kurven in einem Diagramm übersichtlicher für mich ist.
Vielen Dank für deine Hilfe und noch einen schönen Abend.
Mfg Alex

343 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige