Sub AktualisiereXYDiagrammWiderstand() Dim datenWs As Worksheet Dim diagrammWs As Worksheet Dim chartObj As ChartObject Dim diagramm As Chart Dim xRange As Range Dim yRange As Range Dim letzteSpalte As Long Dim letzteZeile As Long Dim i As Long ' Arbeitsblätter definieren Set datenWs = ThisWorkbook.Worksheets(1) ' Blatt mit den Daten Set diagrammWs = ThisWorkbook.Worksheets(3) ' Blatt mit dem Diagramm ' Diagramm definieren Set chartObj = diagrammWs.ChartObjects(1) ' Diagrammname anpassen Set diagramm = chartObj.Chart ' Letzte Zeile und Spalte der Daten finden letzteZeile = datenWs.Cells(datenWs.Rows.Count, 1).End(xlUp).Row ' X-Werte in Spalte A letzteSpalte = datenWs.Cells(3, datenWs.Columns.Count).End(xlToLeft).Column ' Y-Werte ab Spalte B ' MsgBox letzteZeile, vbInformation ' MsgBox letzteSpalte, vbInformation ' X-Werte-Bereich definieren (fix in Spalte A, ab Zeile 3) Set xRange = datenWs.Range(datenWs.Cells(3, 1), datenWs.Cells(letzteZeile, 1)) ' Daten beginnen ab Zeile 3 ' Bestehende Datenreihen im Diagramm entfernen Do While diagramm.SeriesCollection.Count > 0 diagramm.SeriesCollection(1).Delete Loop ' Neue Datenreihen hinzufügen For i = 2 To letzteSpalte ' Y-Werte beginnen in Spalte B Set yRange = datenWs.Range(datenWs.Cells(3, i), datenWs.Cells(letzteZeile, i)) ' Neue Datenreihe hinzufügen With diagramm.SeriesCollection.NewSeries .Name = datenWs.Cells(2, i).Value ' Name der Reihe aus der Kopfzeile (Zeile 1) .XValues = xRange .Values = yRange End With Next i End Sub Sub AktualisiereXYDiagrammKraft() Dim datenWs As Worksheet Dim diagrammWs As Worksheet Dim chartObj As ChartObject Dim diagramm As Chart Dim xRange As Range Dim yRange As Range Dim letzteSpalte As Long Dim letzteZeile As Long Dim i As Long ' Arbeitsblätter definieren Set datenWs = ThisWorkbook.Worksheets(2) ' Blatt mit den Daten Set diagrammWs = ThisWorkbook.Worksheets(4) ' Blatt mit dem Diagramm ' Diagramm definieren Set chartObj = diagrammWs.ChartObjects(1) ' Diagrammname anpassen Set diagramm = chartObj.Chart ' Letzte Zeile und Spalte der Daten finden letzteZeile = datenWs.Cells(datenWs.Rows.Count, 1).End(xlUp).Row ' X-Werte in Spalte A letzteSpalte = datenWs.Cells(3, datenWs.Columns.Count).End(xlToLeft).Column ' Y-Werte ab Spalte B 'MsgBox letzteZeile, vbInformation 'MsgBox letzteSpalte, vbInformation ' X-Werte-Bereich definieren (fix in Spalte A, ab Zeile 3) Set xRange = datenWs.Range(datenWs.Cells(3, 1), datenWs.Cells(letzteZeile, 1)) ' Daten beginnen ab Zeile 3 ' Bestehende Datenreihen im Diagramm entfernen Do While diagramm.SeriesCollection.Count > 0 diagramm.SeriesCollection(1).Delete Loop ' Neue Datenreihen hinzufügen For i = 2 To letzteSpalte ' Y-Werte beginnen in Spalte B Set yRange = datenWs.Range(datenWs.Cells(3, i), datenWs.Cells(letzteZeile, i)) ' Neue Datenreihe hinzufügen With diagramm.SeriesCollection.NewSeries .Name = datenWs.Cells(2, i).Value ' Name der Reihe aus der Kopfzeile (Zeile 1) .XValues = xRange .Values = yRange End With Next i End Sub Sub AktualisiereXYDiagrammInkrementWiderstand() Dim wsAktuell As Worksheet Dim ws As Worksheet Dim chartObj As ChartObject Dim diagramm As Chart Dim letzteZeile As Long Dim letzteSpalte As Long Dim datenBereichX As Range Dim datenBereichY1 As Range Dim datenReihe As Series Dim diagrammTitel As String Dim startZeile As Long Dim blockAnzahl As Long Dim blockStartSpalte As Long Dim blockEndSpalte As Long Dim blockIndex As Integer ' Arbeitsblatt "Widerstandsdiagramm" festlegen Set wsAktuell = ThisWorkbook.Worksheets("Widerstandsdiagramm") ' Diagramm auf "Widerstandsdiagramm" suchen If wsAktuell.ChartObjects.Count = 0 Then MsgBox "Kein Diagramm auf 'Widerstandsdiagramm' gefunden.", vbExclamation Exit Sub End If Set chartObj = wsAktuell.ChartObjects(1) Set diagramm = chartObj.Chart ' Vorhandene Datenreihen löschen Do While diagramm.SeriesCollection.Count > 0 diagramm.SeriesCollection(1).Delete Loop ' Alle Blätter vor "Widerstandsdiagramm" durchlaufen For Each ws In ThisWorkbook.Worksheets If ws.Index < wsAktuell.Index Then ' Letzte Zeile im Blatt ermitteln letzteZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Prüfen, ob relevante Daten vorhanden sind If letzteZeile >= 3 Then ' Startzeile und Anzahl der Datenblöcke definieren startZeile = 3 blockStartSpalte = 1 ' Erste Spalte für x blockEndSpalte = 3 ' Spalten x, y1, y2 blockAnzahl = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column / 3 ' Anzahl Blöcke ' Datenblöcke durchlaufen For blockIndex = 0 To blockAnzahl - 1 ' X-Werte und Y1-Werte für den aktuellen Block definieren With ws Set datenBereichX = .Range(.Cells(startZeile, blockStartSpalte + blockIndex * 3), _ .Cells(letzteZeile, blockStartSpalte + blockIndex * 3)) ' Spalte X Set datenBereichY1 = .Range(.Cells(startZeile, blockStartSpalte + blockIndex * 3 + 1), _ .Cells(letzteZeile, blockStartSpalte + blockIndex * 3 + 1)) ' Spalte Y1 ' Neue Datenreihe hinzufügen Set datenReihe = diagramm.SeriesCollection.NewSeries datenReihe.Values = datenBereichY1 datenReihe.XValues = datenBereichX datenReihe.Name = ws.Name & " - Position " & (blockIndex + 1) End With Next blockIndex End If End If Next ws End Sub Sub AktualisiereXYDiagrammInkrementKraft() Dim wsWiderstand As Worksheet Dim wsKraft As Worksheet Dim ws As Worksheet Dim chartObj As ChartObject Dim diagramm As Chart Dim letzteZeile As Long Dim datenBereichX As Range Dim datenBereichY2 As Range Dim datenReihe As Series Dim diagrammTitel As String Dim startZeile As Long Dim blockAnzahl As Long Dim blockStartSpalte As Long Dim blockEndSpalte As Long Dim blockIndex As Integer ' Arbeitsblätter "Widerstandsdiagramm" und "Kraftdiagramm" festlegen Set wsWiderstand = ThisWorkbook.Worksheets("Widerstandsdiagramm") Set wsKraft = ThisWorkbook.Worksheets("Kraftdiagramm") ' Diagramm auf "Kraftdiagramm" suchen If wsKraft.ChartObjects.Count = 0 Then MsgBox "Kein Diagramm auf 'Kraftdiagramm' gefunden.", vbExclamation Exit Sub End If Set chartObj = wsKraft.ChartObjects(1) Set diagramm = chartObj.Chart ' Vorhandene Datenreihen löschen Do While diagramm.SeriesCollection.Count > 0 diagramm.SeriesCollection(1).Delete Loop ' Alle Blätter vor "Widerstandsdiagramm" durchlaufen For Each ws In ThisWorkbook.Worksheets If ws.Index < wsWiderstand.Index Then ' Letzte Zeile im Blatt ermitteln letzteZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Prüfen, ob relevante Daten vorhanden sind If letzteZeile >= 3 Then ' Startzeile und Anzahl der Datenblöcke definieren startZeile = 3 blockStartSpalte = 1 ' Erste Spalte für x blockEndSpalte = 3 ' Spalten x, y1, y2 blockAnzahl = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column / 3 ' Anzahl Blöcke ' Datenblöcke durchlaufen For blockIndex = 0 To blockAnzahl - 1 ' X-Werte und Y2-Werte für den aktuellen Block definieren With ws Set datenBereichX = .Range(.Cells(startZeile, blockStartSpalte + blockIndex * 3), _ .Cells(letzteZeile, blockStartSpalte + blockIndex * 3)) ' Spalte X Set datenBereichY2 = .Range(.Cells(startZeile, blockStartSpalte + blockIndex * 3 + 2), _ .Cells(letzteZeile, blockStartSpalte + blockIndex * 3 + 2)) ' Spalte Y2 ' Neue Datenreihe hinzufügen Set datenReihe = diagramm.SeriesCollection.NewSeries datenReihe.Values = datenBereichY2 datenReihe.XValues = datenBereichX datenReihe.Name = ws.Name & " - Position " & (blockIndex + 1) End With Next blockIndex End If End If Next ws End Sub