Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1504to1508
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

Diagramm kopieren 10 Zeilen weiter

Diagramm kopieren 10 Zeilen weiter
21.07.2016 16:32:55
Mathias
Hallo Liebe Advanced Excel Anwender!
Mache gerade eine Liste mit Immer gleich aufgebauten Zeilen und Grafiken.
In den Zeilen befinden sich Zeitreihenwerte und am Ende der Zeitreihe soll immer eine passende Grafik sein.
Bsp.
......A....B...C...D...E
1.....12...11..01..9..8
2.....13...9...11..2..5
usw.
Jetzt möchte ich Grafik 1 für Zeile 1-9, Grafik 2 für Zeile 10-19, Grafik 3 für Zeile 20-29 etc.
Leider sidn bei Diagrammen die Zellbezüge immer Absolut und ich muss bei jeder neuen Grafik den Datenbereich neu definieren.
Makro aufzeichnen zeichnet nur alle Einzelschritte auf und ich müsste erst immer extra die Zeilennummer ändern.
1. Versteht ihr halbwegs was ich will?
2. Gibt es da ein elegantes Makro dazu?
Mfg
Mathias

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Diagramm kopieren 10 Zeilen weiter
21.07.2016 18:28:52
Beverly
Hi Matthias,
welcher Diagrammtyp soll erstellt werden? Sind die Daten Spalten- oder Zeilenweise zu verstehen? In welcher Spalte bzw. Zeile befinden sich die Werte für die Achsenbeschriftung?


AW: Diagramm kopieren 10 Zeilen weiter
21.07.2016 21:44:33
Mathias
Hallo Beverly
Das Diagramm 1 soll beispielsweise Zeile 2 und 3 von B bis E als Balkendiagramm enthalten, Diagramm 2 soll dann Zeile 5 und 6 von B bis E enthalten, Diagramm 3 Zeile 8 und 10 von B bis E usw.
Also das Diagramm verschiebt ich immer um einen gleichbleibenden Anzahl an Zeilen und soll immer das selbe Zeilenset und die selben Spalten enthalten
Mfg
Mathias
Anzeige
Was denn nun...
22.07.2016 07:55:33
Beverly
Hi Matthias,
...Zeile 2 und 3, 5 und 6 usw. oder Zeile 1 bis 9, 10 bis 19 usw...? Dass sich der Diagrammbereich immer um die selbe Zeilenanzahl verschiebt hattest du bereits geschrieben - ich kann lesen und musst du nicht wiederholen, nur solltest du dich schon eindeutig festlegen, um wieviele Zeilen.
Tatsächlich Balken- oder doch vielleicht eher Säulendiagramm? Meine Frage zur Achsenbeschriftung hast du nicht beantwortet.
Lade eine Beispielmappe mit 1 Diagramm und dem genauen Tabellenaufbau hoch (mindestens 2 Zellbereiche).


Anzeige
AW: Was denn nun...
22.07.2016 08:55:07
Mathias
Hallo Beverly,
Unter https://www.herber.de/bbs/user/107158.xlsx findest du das Beispielfile mit dummyzahlen
Ich hoffe dann sind alle offenen Punkte geklärt, sorry falls ich mich vorhin wiederholt habe.
Wollte die Logik hinter dem Vorgehen erläutern, ob es im Endeffekt dann Zeile 10 - 12 oder Zeile 10-19 ist hat denke ich nicht die große Auswirkung.
Mfg
Mathias
Wenn es keine Auswirkungen hätte...
22.07.2016 11:06:30
Beverly
Hi Mathias,
...kannst du dir gewiss sein, dass ich in dem Fall nicht darauf bestanden hätte, den tatsächlichen Tabellenaufbau zu kennen.
Und es ist übrigens tatsächlich ein Säulen- und kein Balkendiagramm, wie ich vermutet hatte - komischerweise stehen bei den meisten Leuten die Dachbalken senkrecht im Haus... ;-)))
Es ist außerdem ein Säulendiagramm kombiniert mit einem Punktdiagramm: beide Diagrammarten sind Codemäßig anders zu behandeln - wiederum ein Grund. gleich zu Beginn eine Beispielmappe zur Verfügung zu stellen.
In deinem Diagramm gibt es für die Achsenbeschriftung den Bezug zu einer anderen Arbeitsmappe, die mir nicht vorliegt. Ich habe das Diagramm dahingehend korrigiert, dass ich als Achsenbeschriftung den Bezug zum Bereich B3:M3 eingetragen habe - der Code baut auf dieser Voraussetzung auf:

Sub DiasKopieren()
Dim lngZeile As Long
Dim lngReihe As Long
Dim strFormel As String
Dim strXWerte As String
Dim strYWerte As String
Dim strName As String
Application.ScreenUpdating = False
For lngZeile = 10 To IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row,  _
Rows.Count) Step 7
ActiveSheet.ChartObjects(1).Copy
ActiveSheet.Paste
With ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count)
.Top = Cells(lngZeile + 1, 14).Top
.Left = Cells(lngZeile + 1, 14).Left
With .Chart
For lngReihe = 1 To .SeriesCollection.Count
strFormel = ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count - 1). _
Chart.SeriesCollection(lngReihe).Formula
strYWerte = Split(strFormel, ",")(2)
strYWerte = Worksheets("Tabelle1").Range(strYWerte).Offset(7, 0).Address
strXWerte = Split(strFormel, ",")(1)
If Range(strXWerte).Row  3 Then
strXWerte = Split(strFormel, ",")(1)
strXWerte = Range(strXWerte).Offset(7, 0).Address
strName = Range(strXWerte).Offset(-1, -1).Address
.SeriesCollection(lngReihe).XValues = Worksheets("Tabelle1").Range( _
strXWerte)
Else
strName = Cells(Range(strYWerte).Row, 1).Address
End If
.SeriesCollection(lngReihe).Values = Worksheets("Tabelle1").Range(strYWerte) _
.SeriesCollection(lngReihe).Name = "=Tabelle1!" & strName
Next lngReihe
End With
End With
Next lngZeile
Application.ScreenUpdating = True
End Sub
https://www.herber.de/bbs/user/107162.xlsm


Anzeige
AW: Wenn es keine Auswirkungen hätte...
22.07.2016 12:17:50
Mathias
Hallo Beverly,
ich dachte ich kann es Anhand der Vorlage dann an meine detailanforderungen Anpsassen aber es ist mir einfach zu hoch.
Nachstehend die Datei mit ein bisschen anderen Positionen, ich wäre dir extrem Dankbar wenn du das Makro auf das updaten könntest x] ich bringe es einfach nicht zustande
https://www.herber.de/bbs/user/107165.xlsm
Danke und Mfg
Mathias
Originalmappe nun doch anders?!
22.07.2016 18:59:27
Beverly
Hi Mathias,
als ich dir geschrieben habe, dass du eine Beispielmappe mit dem genauen Tabellenaufbau hochladen sollst, habe ich mir schon etwas dabei gedacht, aber du hast es ja besser gewusst und deshalb sollte ich dich eigentlich mit dem Dilemma jetzt alleine lassen, denn ich habe viel Zeit für den ersten Code investiert, die nun für den Papierkorb war - wer arbeitet schon gerne umsonst, zumal man als Helfer hier seine Freizeit dafür hergibt?!
Sicher sieht es so aus, als ob der Code "nur" an einigen Stellen umzuschreiben und an die neuen Bedingungen anzupassen gewesen sei, aber außerdem musste auch wieder getestet werden und diese gesamte Zeit hätte ich mir sparen können, wenn mir gleich von Beginn an der tatsächliche Tabellenaufbau bekannt gewesen wäre. Lasse es dir bitte für die Zunkunft eine Lehre sein und erleichtere den Helfern die Arbeit, indem du gleich von Beginn an den richtigen Tabellenaufbau bereitstellst, zumal wenn man dich genau darum bittet.
Sub DiasKopieren()
Dim lngZeile As Long
Dim lngReihe As Long
Dim strFormel As String
Dim strXWerte As String
Dim strYWerte As String
Dim strName As String
Application.ScreenUpdating = False
For lngZeile = 16 To IIf(IsEmpty(Cells(Rows.Count, 5)), Cells(Rows.Count, 5).End(xlUp).Row,  _
Rows.Count) Step 10
ActiveSheet.ChartObjects(1).Copy
ActiveSheet.Paste
With ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count)
.Top = Cells(lngZeile, 21).Top
.Left = Cells(lngZeile, 21).Left
With .Chart
For lngReihe = 1 To .SeriesCollection.Count
strFormel = ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count - 1). _
Chart.SeriesCollection(lngReihe).Formula
strYWerte = Split(strFormel, ",")(2)
strYWerte = Worksheets("Tabelle1").Range(strYWerte).Offset(10, 0).Address
strXWerte = Split(strFormel, ",")(1)
If Range(strXWerte).Row  5 Then
strXWerte = Split(strFormel, ",")(1)
strXWerte = Range(strXWerte).Offset(10, 0).Address
strName = Split(strFormel, ",")(0)
strName = Mid(strName, InStr(strName, "!") + 1)
.SeriesCollection(lngReihe).XValues = Worksheets("Tabelle1").Range( _
strXWerte)
Else
strName = Cells(Range(strYWerte).Row, 5).Address
End If
.SeriesCollection(lngReihe).Values = Worksheets("Tabelle1").Range(strYWerte) _
.SeriesCollection(lngReihe).Name = "=Tabelle1!" & strName
Next lngReihe
End With
End With
Next lngZeile
Application.ScreenUpdating = True
End Sub


Anzeige
Kurzfristiges Denken, hat langfristige Folgen..;-)
22.07.2016 11:19:33
EtoPHG

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige