Anzeige
Archiv - Navigation
1380to1384
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mehrere Diagramme auf ein Blatt mit For- Schleife

Mehrere Diagramme auf ein Blatt mit For- Schleife
29.09.2014 19:08:01
Nemyk
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

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
29.09.2014 19:16:21
Beverly
Hi Nemyk,
und WAS funktioniert nicht?
Eine hochgeladene Beispielmappe ist übrigens immer wesentlich hilfreicher als eine ungefähre Beschreibung des Tabellenausbaus.


AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
29.09.2014 19:39:39
Nemyk
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 !

Anzeige
AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
29.09.2014 20:13:19
Beverly
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.


Anzeige
AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
29.09.2014 20:27:05
Nemyk
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

AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
29.09.2014 20:41:12
Beverly
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?


AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
29.09.2014 21:15:57
Nemyk
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 !

Anzeige
AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
29.09.2014 22:33:27
Beverly
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


Anzeige
AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
30.09.2014 18:51:23
Nemyk
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

AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
30.09.2014 21:07:28
Beverly
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


Anzeige
AW: Mehrere Diagramme auf ein Blatt mit For- Schleife
29.09.2014 19:51:02
Nemyk
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 !

310 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige