XY Diagramme aus 2 Tabellenblättern VBA
09.01.2019 11:52:22
Alex
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