Diagramm - willkürlich zusätzliche Datenreihen
29.09.2016 13:46:29
Linda
Ich habe eine Tabelle mit 3 Datenblättern. Auf dem ersten Blatt "Auswertung" werden Diagramme eingefügt, die ihre Werte aus dem Datenblättern "KurveA" und "KurveB" ziehen. Die Daten werden aus einer anderen .csv-Datei eingelesen und die Berechnungen auf dem Datenblatt "Kurve1" finden dann unter Einbeziehung von variablen Werten aus dem Tabellenblatt "Auswertung" statt.
Da gewisse Werte veränderlich sind, habe ich einen Botton "Aktualiserung" eingefügt, der die Berechnungen auf dem Tabellenblatt "KurveA" noch einmal laufen lässt, wenn in "Auswertung" Werte verändert wurden.
Leider ist es jetzt jedoch so, dass meine Diagramme bei der Aktualisierung willkürlich zusätzliche Datenreihen einfügen. Diese Datenreihen kommen aus dem Datenblatt "Auswertung" (Höhe des Bottons "Aktualisierung") und sind die Werte, aufgrund deren Änderung die Aktualisierung durchgeführt werden muss. Habt ihr eine Idee, warum das passiert und wie ich das verhindern kann?
Code:
Sub Aktualisieren()
'KurveA aktualisieren
Dim iRow As Integer
Dim plusRow As Integer
Dim minusRow As Integer
Worksheets("KurveA").Activate
iRow = Cells(Rows.Count, 1).End(xlUp).Row
plusRow = Worksheets("Auswertung").Range("G11")
minusRow = Worksheets("Auswertung").Range("H11")
Range("M2").FormulaR1C1 = "=MAX(R2C8:R[" & plusRow & "]C8)+Auswertung!R7C6"
Range("M2:M" & plusRow + 2).FillDown
Range("N2").FormulaR1C1 = "=MIN(R2C8:R[" & plusRow & "]C8)+Auswertung!R8C6"
Range("N2:N" & plusRow + 2).FillDown
Range("M" & plusRow + 3).FormulaR1C1 = "=MAX(R[" & minusRow & "]C8:R[" & plusRow & "]C8)+ _
Auswertung!R7C6"
Range("M" & plusRow + 3 & ":M" & iRow).FillDown
Range("N" & plusRow + 3).FormulaR1C1 = "=Min(R[" & minusRow & "]C8:R[" & plusRow & "]C8)+ _
Auswertung!R8C6"
Range("N" & plusRow + 3 & ":N" & iRow).FillDown
Worksheets("KurveB").Activate
Application.Calculation = xlCalculationAutomatic
'Diagramme aktualisieren
Dim lngAKurve As Long
Dim lngBKurve As Long
Dim wksA As Worksheet
Dim wksB As Worksheet
'Letzte Zeile ermitteln
Set wksA = Worksheets("KurveA")
Set wksB = Worksheets("KurveB")
With wksA
lngAKurve = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
End With
With wksB
lngBKurve = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
End With
'Diagramm1 einfügen
Worksheets("Auswertung").Activate
With ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Chart
With .Parent
.Top = Range("b20").Top
.Left = Range("b20").Left
End With
'Titel und Legende
.ChartTitle.Caption = "Referenz- und Prüfkurvenverlauf"
.HasLegend = True
.Legend.Position = xlRight
'y-Achse
With .Axes(xlValue, 1)
.HasTitle = True
.AxisTitle.Caption = "Höhe in mm"
End With
'x-Achse
With .Axes(xlCategory, 1)
.HasTitle = True
.AxisTitle.Caption = "Zeit in s"
End With
'Datenreihen einfügen
With .SeriesCollection.NewSeries
.Name = "KurveA"
.XValues = wksA.Range(wksA.Cells(2, 1), wksA.Cells(lngAKurve, 1))
.Values = wksA.Range(wksA.Cells(2, 8), wksA.Cells(lngAKurve, 8))
End With
With .SeriesCollection.NewSeries
.Name = "KurveB"
.XValues = wksB.Range(wksB.Cells(2, 1), wksB.Cells(lngBKurve, 1))
.Values = wksB.Range(wksB.Cells(2, 8), wksB.Cells(lngBKurve, 8))
End With
With .SeriesCollection.NewSeries
.Name = "KurveC"
.XValues = wksB.Range(wksB.Cells(2, 1), wksB.Cells(lngBKurve, 1))
.Values = wksB.Range(wksB.Cells(2, 13), wksB.Cells(lngBKurve, 13))
End With
With .SeriesCollection.NewSeries
.Name = "KurveD"
.XValues = wksA.Range(wksA.Cells(2, 1), wksA.Cells(lngAKurve, 1))
.Values = wksA.Range(wksA.Cells(2, 16), wksA.Cells(lngAKurve, 16))
End With
End With
'Diagramm2 einfügen
With ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Chart
With .Parent
.Top = Range("b39").Top
.Left = Range("b39").Left
End With
'Titel und Legende
.ChartTitle.Caption = "Hüllkurvenverlauf"
.HasLegend = True
.Legend.Position = xlRight
'y-Achse
With .Axes(xlValue, 1)
.HasTitle = True
.AxisTitle.Caption = "Höhe in mm"
End With
'x-Achse
With .Axes(xlCategory, 1)
.HasTitle = True
.AxisTitle.Caption = "Zeit in s"
End With
'Datenreihen einfügen und Farben zuweisen
With .SeriesCollection.NewSeries
.Name = "KurveA"
.XValues = wksA.Range(wksA.Cells(2, 1), wksA.Cells(lngAKurve, 1))
.Values = wksA.Range(wksA.Cells(2, 8), wksA.Cells(lngAKurve, 8))
End With
With .SeriesCollection.NewSeries
.Name = "KurveB"
.XValues = wksB.Range(wksB.Cells(2, 1), wksB.Cells(lngBKurve, 1))
.Values = wksB.Range(wksB.Cells(2, 8), wksB.Cells(lngBKurve, 8))
.Border.Color = RGB(51, 102, 255)
End With
With .SeriesCollection.NewSeries
.Name = "KurveC"
.XValues = wksB.Range(wksB.Cells(2, 1), wksB.Cells(lngBKurve, 1))
.Values = wksB.Range(wksB.Cells(2, 13), wksB.Cells(lngBKurve, 13))
End With
With .SeriesCollection.NewSeries
.Name = "KurveE"
.XValues = wksA.Range(wksA.Cells(2, 1), wksA.Cells(lngAKurve, 1))
.Values = wksA.Range(wksA.Cells(2, 13), wksA.Cells(lngAKurve, 13))
End With
End With
Set wksA = Nothing
Set wksB = Nothing
Worksheets("Auswertung").Activate
End Sub