Thema Datum  Von Nutzer Rating
Antwort
Rot XY-Diagramme erstellen VBA
09.01.2019 10:36:24 Alex
Solved
10.01.2019 09:37:20 Alex
NotSolved

Ansicht des Beitrags:
Von:
Alex
Datum:
09.01.2019 10:36:24
Views:
91
Rating: Antwort:
 Nein
Thema:
XY-Diagramme erstellen VBA

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.

Datum Uhrzeit Wert 1 Wert 2

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 entehen dabei Fehlermeldungen oder es funktioniert nicht richtig. 
Anbei der Code. Ich habe mir überlegt, die Werte erst rüberzukopieren, das Diagramm damit zu erstellen. 

Für etwaige Lösungsvorschläge bin ich sehr dankbar.

Sub Datum_kopieren()
'
' Datum_kopieren Makro
'

'
    Range("A11").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Diagramme").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub
Sub werte_kopieren()
'
' werte_kopieren Makro
'

'
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Diagramme").Select
    Range("B1").Select
    ActiveSheet.Paste
    Sheets("Werte bereinigt").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Diagramme").Select
    Range("C1").Select
    ActiveSheet.Paste
    Range("D1").Select
    Sheets("Werte bereinigt").Select
    Range("E11").Select
    Sheets("Werte unbereinigt").Select
    Range("E11").Select
End Sub
Sub Diagramm_erstellen()
'
' Diagramm_erstellen Makro
'

'
    Range("A1").Select
    Selection.End(xlToRight).Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterLinesNoMarkers
    ActiveChart.SetSourceData Source:=Range("Diagramme!$A$1:$C$105408")
    ActiveSheet.Shapes("Diagramm 15").ScaleWidth 2.25625, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Diagramm 15").ScaleHeight 1.2048611111, msoFalse, _
        msoScaleFromTopLeft
End Sub
Sub löschen()
'
' löschen Makro
'

'
    ActiveWindow.SmallScroll Down:=-18
    ActiveWindow.ScrollRow = 105246
    ActiveWindow.ScrollRow = 105011
    ActiveWindow.ScrollRow = 104660
    ActiveWindow.ScrollRow = 104425
    ActiveWindow.ScrollRow = 103722
    ActiveWindow.ScrollRow = 102550
    ActiveWindow.ScrollRow = 101144
    ActiveWindow.ScrollRow = 99269
    ActiveWindow.ScrollRow = 96690
    ActiveWindow.ScrollRow = 89658
    ActiveWindow.ScrollRow = 79814
    ActiveWindow.ScrollRow = 73133
    ActiveWindow.ScrollRow = 60241
    ActiveWindow.ScrollRow = 53795
    ActiveWindow.ScrollRow = 40903
    ActiveWindow.ScrollRow = 34809
    ActiveWindow.ScrollRow = 23089
    ActiveWindow.ScrollRow = 18518
    ActiveWindow.ScrollRow = 12190
    ActiveWindow.ScrollRow = 7619
    ActiveWindow.ScrollRow = 5861
    ActiveWindow.ScrollRow = 4220
    ActiveWindow.ScrollRow = 939
    ActiveWindow.ScrollRow = 1
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot XY-Diagramme erstellen VBA
09.01.2019 10:36:24 Alex
Solved
10.01.2019 09:37:20 Alex
NotSolved