Thema Datum  Von Nutzer Rating
Antwort
Rot Mehrere Diagramme Worksheetübergreifend
03.11.2021 19:12:58 Stephan
NotSolved

Ansicht des Beitrags:
Von:
Stephan
Datum:
03.11.2021 19:12:58
Views:
78
Rating: Antwort:
  Ja
Thema:
Mehrere Diagramme Worksheetübergreifend

Guten Abend zusammen,

ich arbeite grad an einem Script welches folgenes machen soll:

Ich habe 3 Worksheets mit gleich formatierten Daten mit jeweils 5 Spalten. Innerhalb des Worksheets sind die Spalten gleichlang. Aber über verschiedene WS hinweg kann die Länge variieren.

Im letzten Worksheet "Diagramm" Sollen nun Graphen in EINEM Diagramm erstellt werden. Die DAten dazu kommen aus den anderen Worksheets.

Also:

Worksheet1 | Worksheet2 | Diagramm

 

Mein Script funktioniert auch bisher sehr gut. Das einzige was nicht funktionieren will ist dass alle Graphen in einem Diagramm landen. Ich bekomme immer pro Worksheet ein Diagramm.

Der Fehler müsste meiner Meinung nach irgendwo bei "With .SeriesCollection(1) " liegen welches in in die Schleife einbauen muss. Wenn ich aber statt der 1 eine Variable vergebe bricht der Code ab.

 

Hat jemand einen Tipp?

Danke,

viele Grüße


 

Sub DiagrammeAlleWorksheets()
'
' Makro10 Makro
'

'
Dim r_cnt As Integer 'row count
Dim c_cnt As Integer 'column count
Dim Datenzeile1 As Integer
Dim XSpalte As Integer
Dim ws As Worksheet
Dim wsName As String
Dim wsAnzahl As String
Dim NoWS As Integer         'Laufvariable Anzahl Worksheets in Schleife
Dim i As Integer
Dim lngReihe As Long


   'Diagramme einfügen
       
    
    'r_cnt = Cells(Rows.Count, 1).End(xlUp).Row 'Zeilenende suchen
    Datenzeile1 = 2 'Diagrammstartzeile
    XSpalte = 1
    c_cnt = 2 'YSpalte
    
    'Anzahl Worksheets im Workbook
    wsAnzahl = ActiveWorkbook.Worksheets.Count
    
       
    'Ab hier werden die Diagramme erstellt
    i = 1
    For NoWS = 1 To wsAnzahl - 1
    Sheets(NoWS).Select
    r_cnt = Cells(Rows.Count, 1).End(xlUp).Row 'Zeilenende suchen
           With Sheets("Diagramm").Shapes.AddChart.Chart
            .ChartType = xlXYScatterSmoothNoMarkers
            
            If .SeriesCollection.Count > 0 Then
                For lngReihe = .SeriesCollection.Count To 1 Step -1
                .SeriesCollection(lngReihe).Delete
                Next lngReihe
            End If
            .SeriesCollection.NewSeries
            With .SeriesCollection(1) 
            .Name = Sheets(NoWS).Name   
            .XValues = "=" & Sheets(NoWS).Name & "!" & Range(Cells(Datenzeile1, XSpalte), Cells(r_cnt, XSpalte)).Address
            .Values = "=" & Sheets(NoWS).Name & "!" & Range(Cells(Datenzeile1, c_cnt), Cells(r_cnt, c_cnt)).Address
            End With

        End With
                i = i + 1
                '.HasLegend = False
        
    Next
    MsgBox i
 
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • 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
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • 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

Thema Datum  Von Nutzer Rating
Antwort
Rot Mehrere Diagramme Worksheetübergreifend
03.11.2021 19:12:58 Stephan
NotSolved