Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

Mehrere Diagramme auf ein Blatt mit For- Schleife

Betrifft: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Nemyk
Geschrieben am: 29.09.2014 19:08:01

Hallo Zusammen,

seit vielen Tagen setze ich vor dem Rechner und versuche herauszufinden, was ich fasch gemacht habe bzw. wo der Fehler im unterstehenden Code ist.

In den Spalten B bis O habe ich die Monaten. Jeder einzelner Monat ist dreimal vorhanden (d. h. in der Spalte B = Jan15, Spalte C = Jan15, Spalte D = Jan15, Spalte E = Feb15, ... etc)

In der Spalte A habe ich die Namen (Ab A5 ... A_x, x = 7 im Moment)

Nun zum eigentlichen Problem !

Ich möchte für jede Zeile ab A5 ein Säulendiagramm mit jeweils 3 Säulen (3 Säulen für ein Monat) erstellen.
Aufgrund der Vielzahl der Zeilen möchte ich eine For-Schleife benutzen. Genau beim Einsatz dieser For-Schleife tritt das Problem auf. Die Erstellung eines Säulendiagramm funktioniert soweit sehr gut, wenn ich die For-Schleife als Kommentar und IngZeile = 6 (beispielweise) setze.

Für jede Hilfe bin sehr dankbar !

Bis Später Nemyk

Sub Saeulendiagramme()

   Set wksTab = Worksheets("TAB_ENOM")
   Dim oCT As ChartTitle
   Dim lngZeile As Long
   IngZeile = 6
   'For lngZeile = 5 To 7
   Dim ws As Worksheet
   Set ws = ActiveSheet
   Sheets.Add after:=Sheets(Sheets.Count)
   ActiveSheet.Name = "Auslast._Graph_" & Format(Now, "yyyymmdd_hhmmss")
      With ActiveSheet.Shapes.AddChart.Chart
         .ChartType = xlColumnClustered
         .SetSourceData Source:=wksTab.Range("B5")

         .SeriesCollection(1).XValues = Union(wksTab.Range("C" & 4), wksTab.Range("F" & 4),  _
wksTab.Range("I" & 4), wksTab.Range("L" & 4), wksTab.Range("O" & 4), wksTab.Range("R" & 4))
         
         .SeriesCollection(1).Values = Union(wksTab.Range("B" & IngZeile), wksTab.Range("E" &   _
_
IngZeile), wksTab.Range("H" & IngZeile), wksTab.Range("K" & IngZeile), wksTab.Range("N" &  _
IngZeile), wksTab.Range("Q" & IngZeile))
         .SeriesCollection(1).Interior.ColorIndex = 20
         .SeriesCollection(1).Name = "A Stunden"
         .SeriesCollection(1).ApplyDataLabels ShowValue:=True
         
         .SeriesCollection.NewSeries
         .SeriesCollection(2).Values = Union(wksTab.Range("C" & IngZeile), wksTab.Range("F" &   _
_
IngZeile), wksTab.Range("I" & IngZeile), wksTab.Range("L" & IngZeile), wksTab.Range("O" &  _
IngZeile), wksTab.Range("R" & IngZeile))
         .SeriesCollection(2).Interior.ColorIndex = 26
         .SeriesCollection(2).Name = "B Stunden"
         .SeriesCollection(2).ApplyDataLabels ShowValue:=True
         
         .SeriesCollection.NewSeries
         .SeriesCollection(3).Values = Union(wksTab.Range("D" & IngZeile), wksTab.Range("G" &   _
_
IngZeile), wksTab.Range("J" & IngZeile), wksTab.Range("M" & IngZeile), wksTab.Range("P" &  _
IngZeile), wksTab.Range("S" & IngZeile))
         .SeriesCollection(3).Interior.ColorIndex = 36
         .SeriesCollection(3).Name = "C Stunden"
         .SeriesCollection(3).ApplyDataLabels ShowValue:=True
         
       ' Make sure the chart has a title
          'Chart
          .HasTitle = True
 
          ' Get the ChartTitle object
         Set oCT = .ChartTitle
 
          ' Format the ChartTitle
            With oCT
              .Caption = wksTab.Range("A" & IngZeile)
              .Font.Name = "Times New Roman"
              .Font.Size = 15
              .Border.LineStyle = xlContinuous
              .Border.Weight = xlThin
              .Shadow = True
            End With
 
            Set oCT = Nothing
      End With
   Next IngZeile
End Sub

  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Beverly
Geschrieben am: 29.09.2014 19:16:21

Hi Nemyk,

und WAS funktioniert nicht?

Eine hochgeladene Beispielmappe ist übrigens immer wesentlich hilfreicher als eine ungefähre Beschreibung des Tabellenausbaus.


GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Nemyk
Geschrieben am: 29.09.2014 19:39:39

Hallo Karin,

Vielen Dank für die schnelle Antwort !

Die For-Scheife funktioniert bis dato leider nicht. Ich bekomme eine Fehlermeldung "Next ohne For"

Anbei die XLS-File mit Beispieldaten
https://www.herber.de/bbs/user/92887.xlsx

Für jede Hilfe bin ich dankbar !


  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Beverly
Geschrieben am: 29.09.2014 20:13:19

Hi Nemyk,

also rigendwir komme ich mit dem was du im Beitrag geschrieben hast und dem was dein Code aussagt nicht so richtig klar. Was soll denn nun gemacht werden:

1. soll für jedes Diagramm ein neues Tabellenblatt erstellt werden oder soll 1 neues Tabellenblatt erstellt und darauf dann alle Diagramme?

2. sollen die Diagramme mit jeweils 3 Datenreihen erstellt und sozusagen in Dreierschritten die Schleife durchlaufen werden und danach jeweils ein neues Diagramm erstellt werden, wobei die Leerzeile anzeigt, dass dort ein neues Diagrmam beginnt?

Übrigens: wenn du eine Mape mit Code hast, dann musst du sie im Format .xlsm abspeichern, sonst ist der Code beim erneuten Öffnen weg.


GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Nemyk
Geschrieben am: 29.09.2014 20:27:05

Hallo Karin,

Danke für die Rückmeldung !

1. Es soll ein neues Tabellenblatt erstellt und darauf dann alle Diagramme.

2. Jedes Diagramm soll mit 3 Datenreihen (3 Säulen pro Diagramm) erstellt werden.

Ich hoffe, dass es jetzt verständlicher ist.

Vielen Dank noch Deine Bemühungen

Nemyk


  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Beverly
Geschrieben am: 29.09.2014 20:41:12

Hi Nemy,

ausgehend von deiner Mappe - welche Zellen sollen ganz konkret in das 1. Diagramm? Vielleicht könntest du ja mal von Hand 1 Diagramm erstellen.
Was soll die Leerzeile?


GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Nemyk
Geschrieben am: 29.09.2014 21:15:57

Hallo Karin,

ich habe jetzt die Excel-Datei mit Makro erstellt. Das Diagramm siehst Du, wenn Du der Code kompilierst. Dabei habe ich die For-Schleife weggenommen und nur für einen bestimmten Wert IngZeile = 6 versucht.

https://www.herber.de/bbs/user/92889.xlsm

Vielen Dank !


  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Beverly
Geschrieben am: 29.09.2014 22:33:27

Hi Nemyk,

ich würde es so lösen: zuerst ein Diagramm aus den Zeilen 4 und 5 erstellen, dann dieses kopieren und die Zeilenbezüge für die Datenreihen anpassen

Sub Saeulendiagramme()
   Dim lngZeile As Long
   Dim wksTab As Worksheet
   Dim strTabelle As String
   Set wksTab = Worksheets("TAB_ENM")
   strTabelle = "Auslast._Graph_" & Format(Now, "yyyymmdd_hhmmss")
   Sheets.Add after:=Sheets(Sheets.Count)
   ActiveSheet.Name = strTabelle
   Application.ScreenUpdating = False
   With Worksheets(strTabelle)
      With .Shapes.AddChart.Chart
         .ChartType = xlColumnClustered
         With .SeriesCollection.NewSeries
            .XValues = Union(wksTab.Range("C4"), wksTab.Range("F5"), wksTab.Range("I4"), _
                wksTab.Range("L4"), wksTab.Range("O4"), wksTab.Range("R4"))
            .Values = Union(wksTab.Range("B5"), wksTab.Range("E5"), wksTab.Range("H5"), _
                wksTab.Range("K5"), wksTab.Range("N5"), wksTab.Range("Q5"))
            .Interior.ColorIndex = 20
            .Name = "Anwesenheitsstunden"
            .ApplyDataLabels ShowValue:=True
         End With
         With .SeriesCollection.NewSeries
            .Values = Union(wksTab.Range("C5"), wksTab.Range("F5"), wksTab.Range("I5"), _
                wksTab.Range("L5"), wksTab.Range("O5"), wksTab.Range("R5"))
            .Interior.ColorIndex = 26
            .Name = "Auftragsbearbeitungs Stunden"
            .ApplyDataLabels ShowValue:=True
         End With
         With .SeriesCollection.NewSeries
            .Values = Union(wksTab.Range("D5"), wksTab.Range("G5"), wksTab.Range("J5"), _
                wksTab.Range("M5"), wksTab.Range("P5"), wksTab.Range("S5"))
            .Interior.ColorIndex = 36
            .Name = "Kalkulierte Stunden"
            .ApplyDataLabels ShowValue:=True
         End With
         .HasTitle = True
         With .ChartTitle
              .Caption = wksTab.Range("A5")
              .Font.Name = "Times New Roman"
              .Font.Size = 15
              .Border.LineStyle = xlContinuous
              .Border.Weight = xlThin
              .Shadow = True
         End With
      End With
      For lngZeile = 6 To 7
         .ChartObjects(1).Chart.ChartArea.Copy
         Application.Goto reference:=Worksheets(strTabelle).Range("A1")
         ActiveSheet.Paste
         With .ChartObjects(.ChartObjects.Count).Chart
            With .SeriesCollection(1)
               .XValues = Union(wksTab.Range("C" & 4), wksTab.Range("F" & 4), wksTab.Range("I" & _
 4), _
                    wksTab.Range("L" & 4), wksTab.Range("O" & 4), wksTab.Range("R" & 4))
               .Values = Union(wksTab.Range("B" & lngZeile), wksTab.Range("E" & lngZeile), _
                    wksTab.Range("H" & lngZeile), wksTab.Range("K" & lngZeile), _
                    wksTab.Range("N" & lngZeile), wksTab.Range("Q" & lngZeile))
            End With
            With .SeriesCollection(2)
               .Values = Union(wksTab.Range("C" & lngZeile), wksTab.Range("F" & lngZeile), _
                    wksTab.Range("I" & lngZeile), wksTab.Range("L" & lngZeile), _
                    wksTab.Range("O" & lngZeile), wksTab.Range("R" & lngZeile))
            End With
            With .SeriesCollection(3)
               .Values = Union(wksTab.Range("D" & lngZeile), wksTab.Range("G" & lngZeile), _
                    wksTab.Range("J" & lngZeile), wksTab.Range("M" & lngZeile), _
                    wksTab.Range("P" & lngZeile), wksTab.Range("S" & lngZeile))
            End With
            .HasTitle = True
            .ChartTitle.Caption = wksTab.Range("A" & lngZeile)
            .Parent.Top = Worksheets(strTabelle).ChartObjects(lngZeile - 5).Top + _
                 Worksheets(strTabelle).ChartObjects(1).Height
            .Parent.Left = Worksheets(strTabelle).ChartObjects(lngZeile - 5).Left
         End With
     Next lngZeile
   End With
   Set wksTab = Nothing
   Application.ScreenUpdating = False
End Sub

GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Nemyk
Geschrieben am: 30.09.2014 18:51:23

WAOUH !!!!

Vielen Dank Karin !
Es funktioniert, wie ich es mir vorgestellt habe.

Ich hätte gerne noch einen Wunsch. Alle Namen, von A bis G lassen sich mit einem Filter aussortieren. Jeder einzelne Name oder alle Namen gleichzeitig können ausgewählt werden, bevor die Erstellung der Diagramme stattfinden.

Wie kann ich der VBA-Code jetzt anpassen

Vielen Dank für Deine Hilfe !
Gruß, Nemyk


  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Beverly
Geschrieben am: 30.09.2014 21:07:28

Hi Nemyk,

es wäre wesentlich hilfreicher und produktiver gewesen, wenn du diese Bedingung gleich von Anfang an erwähnt hättest, dann hätte ich den Code jetzt nicht extra umschreiben müssen, denn mein Konzept funktioniert so nicht mehr wie unter den zuerst genannten Bedingungen - der Code war nämlich genau an diese angepasst. Beachte das bitte in Zukunft - das erspart den Helfern viel zustzliche Arbeit.

Sub Saeulendiagramme()
   Dim lngZeile As Long
   Dim wksTab As Worksheet
   Dim strTabelle As String
   Dim lngZaehler As Long
   Dim blnStart As Boolean
   Set wksTab = Worksheets("TAB_ENM")
   strTabelle = "Auslast._Graph_" & Format(Now, "yyyymmdd_hhmmss")
   Sheets.Add after:=Sheets(Sheets.Count)
   ActiveSheet.Name = strTabelle
   Application.ScreenUpdating = False
   With Worksheets(strTabelle)
      For lngZeile = 5 To 11
         If wksTab.Rows(lngZeile).Hidden = False Then
            If blnStart = False Then
                With .Shapes.AddChart.Chart
                   .ChartType = xlColumnClustered
                   With .SeriesCollection.NewSeries
                      .XValues = Union(wksTab.Range("C4"), wksTab.Range("F5"), _
                          wksTab.Range("I4"), wksTab.Range("L4"), wksTab.Range("O4"), _
                          wksTab.Range("R4"))
                      .Values = Union(wksTab.Range("B5"), wksTab.Range("E5"), _
                          wksTab.Range("H5"), wksTab.Range("K5"), wksTab.Range("N5"), _
                          wksTab.Range("Q5"))
                      .Interior.ColorIndex = 20
                      .Name = "Anwesenheitsstunden"
                      .ApplyDataLabels ShowValue:=True
                   End With
                   With .SeriesCollection.NewSeries
                      .Values = Union(wksTab.Range("C5"), wksTab.Range("F5"), _
                          wksTab.Range("I5"), wksTab.Range("L5"), wksTab.Range("O5"), _
                          wksTab.Range("R5"))
                      .Interior.ColorIndex = 26
                      .Name = "Auftragsbearbeitungs Stunden"
                      .ApplyDataLabels ShowValue:=True
                   End With
                   With .SeriesCollection.NewSeries
                      .Values = Union(wksTab.Range("D5"), wksTab.Range("G5"), _
                          wksTab.Range("J5"), wksTab.Range("M5"), wksTab.Range("P5"), _
                          wksTab.Range("S5"))
                      .Interior.ColorIndex = 36
                      .Name = "Kalkulierte Stunden"
                      .ApplyDataLabels ShowValue:=True
                   End With
                   .HasTitle = True
                   With .ChartTitle
                       .Caption = wksTab.Range("A5")
                       .Font.Name = "Times New Roman"
                       .Font.Size = 15
                       .Border.LineStyle = xlContinuous
                       .Border.Weight = xlThin
                       .Shadow = True
                   End With
                End With
                blnStart = True
            Else
                lngZaehler = lngZaehler + 1
                .ChartObjects(1).Chart.ChartArea.Copy
                Application.Goto reference:=Worksheets(strTabelle).Range("A1")
                ActiveSheet.Paste
                With .ChartObjects(.ChartObjects.Count).Chart
                   With .SeriesCollection(1)
                      .XValues = Union(wksTab.Range("C" & 4), wksTab.Range("F" & 4), _
                         wksTab.Range("I" & 4), wksTab.Range("L" & 4), _
                         wksTab.Range("O" & 4), wksTab.Range("R" & 4))
                      .Values = Union(wksTab.Range("B" & lngZeile), _
                         wksTab.Range("E" & lngZeile), wksTab.Range("H" & lngZeile), _
                         wksTab.Range("K" & lngZeile), wksTab.Range("N" & lngZeile), _
                         wksTab.Range("Q" & lngZeile))
                   End With
                   With .SeriesCollection(2)
                      .Values = Union(wksTab.Range("C" & lngZeile), _
                         wksTab.Range("F" & lngZeile), wksTab.Range("I" & lngZeile), _
                         wksTab.Range("L" & lngZeile), wksTab.Range("O" & lngZeile), _
                         wksTab.Range("R" & lngZeile))
                   End With
                   With .SeriesCollection(3)
                      .Values = Union(wksTab.Range("D" & lngZeile), _
                         wksTab.Range("G" & lngZeile), wksTab.Range("J" & lngZeile), _
                         wksTab.Range("M" & lngZeile), wksTab.Range("P" & lngZeile), _
                         wksTab.Range("S" & lngZeile))
                   End With
                   .HasTitle = True
                   .ChartTitle.Caption = wksTab.Range("A" & lngZeile)
                   .Parent.Top = Worksheets(strTabelle).ChartObjects(lngZaehler).Top + _
                        Worksheets(strTabelle).ChartObjects(1).Height
                   .Parent.Left = Worksheets(strTabelle).ChartObjects(1).Left
                End With
            End If
         End If
     Next lngZeile
   End With
   Set wksTab = Nothing
   Application.ScreenUpdating = False
End Sub

GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Mehrere Diagramme auf ein Blatt mit For- Schleife von: Nemyk
Geschrieben am: 29.09.2014 19:51:02

Hallo Karin,

Vielen Dank für die schnelle Antwort !

Die For-Scheife funktioniert bis dato leider nicht. Ich bekomme eine Fehlermeldung "Next ohne For"

Anbei die XLS-File mit Beispieldaten
https://www.herber.de/bbs/user/92887.xlsx

Für jede Hilfe bin ich dankbar !


 

Beiträge aus den Excel-Beispielen zum Thema "Mehrere Diagramme auf ein Blatt mit For- Schleife"