Anzeige
Archiv - Navigation
1316to1320
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 automatisch erstellen

Diagramm automatisch erstellen
19.06.2013 12:06:54
Jens
Hallo,
Ich bin auf der Suche nach einem Makro für Excel 2013 um aus einer 8808 Daten umfassenden Spalte (Spalte F beginnend mit Zeile 2 - Zeile 8809) immer jeweils 72 dieser Daten zu einem Liniendiagramm zusammenzufügen und neben den entsprechenden Abschnitt zu platzieren.
Da es sich thematisch um die Stromerzeugung von Photovoltaik in Deutschland handelt sind viele Daten Null und sollen auch als 0 gezeichnet werden.
Ich hoffe mir kann jemand weiterhelfen.

28
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Diagramm automatisch erstellen
19.06.2013 12:17:38
Rudi
Hallo,
lad mal ein Beispiel hoch.
Gruß
Rudi

Hallo Rudi! Wenn du Lust hast ...
19.06.2013 13:16:40
Klaus
... magst du dir meine Lösung mal ansehen? Ich hab da noch ein paar Zinken drin, mit "ActiveChart" und "ActiveSheet" die man vielleicht optimaler gestalten kann. Über deine professionelle Meinung würd ich mich freuen!
Grüße,
Klaus M.vdT.

AW: Hallo Rudi! Wenn du Lust hast ...
19.06.2013 15:04:12
Rudi
Hallo Klaus,
danke für dein Interesse an meiner Meinung.
Den Knaller finde ich das:
Range(ActiveSheet.Name & "!" & Range(Cells(rowFrom, SpalteDaten), Cells(rowTo, SpalteDaten)).Address)
Du ermittels die Adresse eines Ranges, um genau den gleichen Range zurückzugeben.
Das ist von hinten durch die Brust ins Auge. Was ist wohl Range(Range("A1").Address)? Range("A1")!
Range(Cells(rowFrom, SpalteDaten), Cells(rowTo, SpalteDaten)) würde vollkommen ausreichen.
Außerdem würde ich den Datenbereich direkt an die Unterroutine übergeben anstatt die Anfangs- und die Endzeile.
Sub MacheVieleDiagramme()
Const RowFirst As Long = 2
Const RowStep As Long = 72
Const SpalteDaten = 6
Dim RowLast As Long
Dim i As Long
Application.ScreenUpdating = False
With ActiveSheet
RowLast = .Cells(.Rows.Count, SpalteDaten).End(xlUp).Row
For i = RowFirst To RowLast Step RowStep
MacheEinzelDiagramm Cells(i, SpalteDaten).Resize(RowStep)
Next i
End With
End Sub
Sub MacheEinzelDiagramm(rngDaten As Range)
Dim myCht As Object
Set myCht = ActiveSheet.Shapes.AddChart
With myCht
With .Chart
.ChartType = xlLine
.SetSourceData Source:=rngDaten
End With
.Top = rngDaten.Top
.Left = rngDaten.Offset(, 1).Left
.Height = rngDaten.Height
.Width = rngDaten.Offset(, 1).Width
End With
End Sub

Gruß
Rudi

Anzeige
AW: Hallo Rudi! Wenn du Lust hast ...
19.06.2013 15:18:20
Klaus
Hallo Rudi,
Der "Knaller" kommt vom Rekordercode-Umschreiben, ich dachte ich muss hier die Adresse als "String" zurück geben um sie mit "Dateiname!" kombinieren zu können.
  Set myCht = ActiveSheet.Shapes.AddChart
With myCht

ja, genau das fehlte mir um das selektieren des Charts zu vermeiden!
Um die Breite / Höhe des Chart anzupassen habe ich gegoogelt und nur
ActiveSheet.Shapes("Diagramm1").Top
gefunden. Darum meine umständliche Lösung, den Diagramm-Namen aus Select zu ermitteln und dann als Shape anzusprechen.
Ob ich den Datenbereich oder die Zeilen übergebe ist 6 oder ein halbes dutzend, hätte ich zunächst gesagt. Jetzt wo ich sehe wie du mit rngDaten.Top usw eine ständige wiederholung von Range(cells(z,s),cells(z,s)) vermeidest sehe ich aber, dass diese Lösung eleganter ist.
Rudi, vielen dank für das Teilhaben an deinem Wissensfundus!
Gruße,
Klaus M.vdT.

Anzeige
Range-Objekt
19.06.2013 15:51:44
Rudi
Hallo,
eine ständige wiederholung von Range(cells(z,s),cells(z,s)) vermeidest sehe ich aber, dass diese Lösung eleganter ist.
Das mach ich nicht um der Eleganz, sondern um der Geschwindigkeit willen.
Die ständige Neuermittlung mittels Range(cells(z,s),cells(z,s)) frisst erheblich Zeit wie du an diesen simplen Codes sehen kannst.
Sub aaa()
bbb 10, 100, 100000
ccc Range(Cells(10, 1), Cells(100, 1)), 100000
End Sub

Sub bbb(a, b, c)
Dim t, i, s
t = Timer
For i = 1 To c
s = Range(Cells(a, 1), Cells(b, 1)).Address
Next
Debug.Print Timer - t
End Sub

Sub ccc(r As Range, c)
Dim t, i, s
t = Timer
For i = 1 To c
s = r.Address
Next
Debug.Print Timer - t
End Sub
Gruß
Rudi

Anzeige
Range-Objekt
19.06.2013 15:51:45
Rudi
Hallo,
eine ständige wiederholung von Range(cells(z,s),cells(z,s)) vermeidest sehe ich aber, dass diese Lösung eleganter ist.
Das mach ich nicht um der Eleganz, sondern um der Geschwindigkeit willen.
Die ständige Neuermittlung mittels Range(cells(z,s),cells(z,s)) frisst erheblich Zeit wie du an diesen simplen Codes sehen kannst.
Sub aaa()
bbb 10, 100, 100000
ccc Range(Cells(10, 1), Cells(100, 1)), 100000
End Sub

Sub bbb(a, b, c)
Dim t, i, s
t = Timer
For i = 1 To c
s = Range(Cells(a, 1), Cells(b, 1)).Address
Next
Debug.Print Timer - t
End Sub

Sub ccc(r As Range, c)
Dim t, i, s
t = Timer
For i = 1 To c
s = r.Address
Next
Debug.Print Timer - t
End Sub
Gruß
Rudi

Anzeige
verstanden! AW: Range-Objekt
19.06.2013 16:01:47
Klaus
Hi Rudi,
Hätte ich dir auch aufs Wort geglaubt, aber wenn du es mit Code hinterlegst probiere ich es natürlich aus!
0,4 zu 0,1 Sek - vier mal schneller, das ist schon eine Hausnummer!
Ich merke mir jetzt: Range-Objekte möglichst nur einmal zuweisen und dann recyceln spart generell Zeit. (Dass es sich nebenher "eleganter" anfühlt, macht ja nichts ...)
Danke nochmal,
Grüße,
Klaus M.vdT.

AW: Diagramm automatisch erstellen
19.06.2013 12:37:00
Klaus
Hi jens,
dein Beispiel habe ich mir noch nicht angesehen, aber probier mal dieses Makro. Achtung! Die Tabelle muss AKTIVIERT sein, während das Makro läuft!
MacheVieleDiagramme ist das Start-Makro.
Option Explicit
Const SpalteDaten = 6
Const FixWidth = 300
Sub MacheVieleDiagramme()
Const RowFirst As Long = 2
Const RowStep As Long = 72
Dim RowLast As Long
Dim i As Long
With ActiveSheet
RowLast = .Cells(.Rows.Count, SpalteDaten).End(xlUp).Row
For i = RowFirst To RowLast Step RowStep
Call MacheEinzelDiagramm(i, i + RowStep - 1)
Next i
End With
End Sub
Sub MacheEinzelDiagramm(rowFrom As Long, rowTo As Long)
Dim NameTemp As String
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.ChartType = xlLine
.SetSourceData Source:=Range(ActiveSheet.Name & "!" & Range(Cells(rowFrom, SpalteDaten),  _
Cells(rowTo, SpalteDaten)).Address)
NameTemp = WorksheetFunction.Substitute(.Name, ActiveSheet.Name & " ", "")
Debug.Print NameTemp
End With
With ActiveSheet.Shapes(NameTemp)
.Top = Cells(rowFrom, SpalteDaten).Top
.Left = Cells(rowFrom, SpalteDaten + 1).Left
.Height = Range(ActiveSheet.Name & "!" & Range(Cells(rowFrom, SpalteDaten), Cells(rowTo,  _
SpalteDaten)).Address).Height
.Width = FixWidth
End With
End Sub

Anzeige
AW: Diagramm automatisch erstellen
19.06.2013 12:47:53
Jens
Perfekt DANKE!!!
Eine Frage nur noch: Gibt es eine Möglichkeit, dass die erzeugten Diagramme breiter dargestellt werden und nicht so gequetscht sind? (momentan 72 Zeilen hoch,6 Spalten breit).

AW: Diagramm automatisch erstellen
19.06.2013 12:51:08
Klaus
Hi,
ganz oben steht:
Const FixWidth = 300
Trag da eine breite ein wie sie dir gefällt. 600 währ halt doppelt so breit wie es jetzt ist, einfach mal mit rumspielen.
(ich dachte mir das schon, darum habe ich diese Variable wohlwissend nach ganz oben gestellt)
Grüße,
Klaus M.vdT.

AW: Diagramm automatisch erstellen
19.06.2013 12:57:38
Jens
AH okay danke =)
Klappt super!
Vielen Lieben Dank!

Anzeige
Danke für die Rückmeldung! mit Text
19.06.2013 13:15:25
Klaus
Hallo und danke für die Rückmeldung, es freut mich geholfen zu haben!
Wenn du das hier nicht mehr liest, kein Problem: Das Makro funktioniert ja. Falls doch, ich habe noch ein paar Schönheitsfehler beseitigt, den Ablauf etwas optimaler gestaltet, unnötige Variablen entfernt und den Code grob durchkommentiert. Ausserdem habe ich ein paar "debug.print" die vom Testen noch im Code waren rausgeworfen.
Ausserdem fand ich, dass bei einer einzelnen Datenreihe die "Legende" am Rand nur Platz verschwendet und lasse sie im Makro gleich entfernen.
Wenn du magst, kannst du lieber diesen etwas besseren (aber genauso funktionalen) Code nutzen.
Option Explicit
Const SpalteDaten As Long = 6   'Einträge in Spalte F = 6
Const FixWidth As Integer = 600 'Diagramme werden 600 px breit
Const RowFirst As Long = 2      'In Zeile 2 gehts los
Const RowStep As Long = 72      'alle 72 Zeilen ein neues Diagramm
Sub MacheVieleDiagramme()
Dim i As Long
'alle Zeilen durchlaufen, in 72-er Schritten
For i = RowFirst To Cells(Rows.Count, SpalteDaten).End(xlUp).Row Step RowStep
'jeweils das Diagramm-Makro aufrufen
Call MacheEinzelDiagramm(i, i + RowStep - 1)
Next i
End Sub
Sub MacheEinzelDiagramm(rowFrom As Long, rowTo As Long)
'neues Diagramm hinzufügen
ActiveSheet.Shapes.AddChart.Select
'das gerade hinzugefügte Diagramm ist automatisch das "Active Chart"!
With ActiveChart
'als Liniendiagramm definieren
.ChartType = xlLine
'Diagrammquelle festlegen
.SetSourceData _
Source:=Range(ActiveSheet.Name & "!" & Range(Cells(rowFrom, SpalteDaten), Cells(rowTo,  _
SpalteDaten)).Address)
'Legende entfernen
.Legend.Delete
End With
'Diagramm-Name (ohne Blatt-Name) ermitteln und damit die Diagrammpositionen festlegen
With ActiveSheet.Shapes(WorksheetFunction.Substitute(ActiveChart.Name, ActiveSheet.Name & " ", " _
"))
'oben = erste Zeile des Datenbereichs
.Top = Cells(rowFrom, SpalteDaten).Top
'links = eine Spalte rechts (darum +1) des Datenbereichs
.Left = Cells(rowFrom, SpalteDaten + 1).Left
'Höhe = die höhe des Datenbereichs
.Height = Range(Cells(rowFrom, SpalteDaten), Cells(rowTo, SpalteDaten)).Height
'Breite = wie oben angegeben
.Width = FixWidth
End With
End Sub
Grüße,
Klaus M.vdT.

Anzeige
AW: Danke für die Rückmeldung! mit Text
19.06.2013 14:59:16
Jens
Vielen Dank nur leider sagt mir Excel, dass ein Syntax Error vorliegt bei With ActiveSheet.Shapes(WorksheetFunction.Substitute(ActiveChart.Name, ActiveSheet.Name & " ", " _
"))

Zeilenumbruch
19.06.2013 15:01:18
Klaus
Hi Jens,
die Zeile funktioniert. Da ist ein Zeilenumbruch (von Herber) drin, den musst du rausnehmen.
also, all das:
With ActiveSheet.Shapes(
WorksheetFunction.Substitute(
ActiveChart.Name, ActiveSheet.Name & " ", ""))
ist nur eine Zeile.
Grüße,
Klaus M.vdT.

AW: Zeilenumbruch
19.06.2013 15:15:26
Jens
So nun funktioniert alles. Ich musste den _ Strich noch entfernen, damit es funktioniert hat. Gibt es die Möglichkeit, die Y-Achse der Diagramme einheitlich zu gestalten (das Diagramm mit den höchsten Y-Werten als Referenz sozusagen?)

Anzeige
Einheitliche Y-Achse
19.06.2013 15:33:03
Klaus
Hallo Jens,
ich habe dir den Wunsch der einheitlichen Y-Achse eingebaut. Die Y-Achse skaliert jetzt von 0 bis zum Max-Wert der in Spalte F gefunden wurde.
Als Basis habe ich nicht meinen Code, sondern die stark verbesserte Version von Rudi genommen also nicht wundern!
Option Explicit
'ÄNDERUNG!
'die Diagrammbreite nicht mehr im Makro angeben, sondern
'das Diagramm nimmt die Breite der Spalte F an!
Public ScaleMax As Long
Public ScaleMin As Long
Sub MacheVieleDiagramme()
Const RowFirst As Long = 2 'Ab Zeile 2 stehen Daten
Const RowStep As Long = 72 'Diagramme in 72-Zeilen-Schritten erstellen
Const SpalteDaten = 6      'In Spalte F=6 stehen die Daten
Dim i As Long
'Bildschirmflackern verhindern
Application.ScreenUpdating = False
With ActiveSheet
'Diagramm scaliert von 0 bis Max-Wert
'Bei Bedarf ändern, auch fixe Werte möglich!
ScaleMax = WorksheetFunction.Max(.Cells(1, SpalteDaten).EntireColumn)
ScaleMin = 0
'gehe alle Zeilen in 72-er Steps durch
For i = RowFirst To Cells(.Rows.Count, SpalteDaten).End(xlUp).Row Step RowStep
'starte das Diagramm-Makro
MacheEinzelDiagramm .Cells(i, SpalteDaten).Resize(RowStep)
Next i
End With
End Sub
Sub MacheEinzelDiagramm(rngDaten As Range)
Dim myCht As Object
Set myCht = ActiveSheet.Shapes.AddChart       'neues Diagramm erstellen
With myCht                                    'mit dem gerade erstellten Diagramm
With .Chart
.ChartType = xlLine                       'Liniendiagramm
.SetSourceData Source:=rngDaten           'Datenquelle übergeben
.Legend.Delete                            'Legende entfernen
.Axes(xlValue).MaximumScale = ScaleMax    'auf 22000 (oder so) skalieren
.Axes(xlValue).MinimumScale = ScaleMin    'von 0 anfangend skalieren
End With
.Top = rngDaten.Top                         'ausrichten
.Left = rngDaten.Offset(, 1).Left           'ausrichten
.Height = rngDaten.Height                   'ausrichten
.Width = rngDaten.Offset(, 1).Width         'ausrichten
End With
End Sub
Grüße,
Klaus M.vdT.

Anzeige
AW: Einheitliche Y-Achse
19.06.2013 15:44:08
Jens
hmm ich bekomme von Excel einen Laufzeitfehler 1004 - die Max Eigenschaft des WorksheetFunktion-Objektes kann nicht zugeordnet werden. Hab ich wieder einen Umbruch vergessen? Beim Debuggen wird die Zeile " ScaleMax = WorksheetFunction.Max(.Cells(1, SpalteDaten).EntireColumn)" gelb markiert.

AW: Einheitliche Y-Achse
19.06.2013 15:53:57
Klaus
Hallo Jens,
ich muss ja mal einwerfen, auch ein fortgeschrittener Thread ist kein Grund auf Anrede und Gruß zu verzichten!
Die Zeile ist valide und funktioniert bei mir. Es kann sein, dass du irgendeinen Verweis auf eine Bibilothek brauchst um die Worksheetfunction zu benutzen ...
Hier ein paar Workarounds, die du probieren müsstest:
1) Vielleicht hilft es, direkter zu verweisen:
    '**************************************
ScaleMax = Application.WorksheetFunction.Max(.Cells(1, SpalteDaten).EntireColumn)
ScaleMin = 0
'**************************************

2) Notfalls, den MAX-Wert in eine Zelle schreiben, aus der Zelle auslesen und dann wieder löschen
    '**************************************
.Cells(1, SpalteDaten + 1).FormulaR1C1 = "=MAX(C" & SpalteDaten & ")"
ScaleMax = .Cells(1, SpalteDaten + 1).Value
ScaleMin = 0
.Cells(1, SpalteDaten + 1).ClearContents
'**************************************

3) Die ganz brutale Methode: Den Wert einfach fixieren klappt auf jedem Fall! Ist aber nicht so schön variabel wie die anderen Methoden ... Sprich, wenn du mal einen 30.000er Wert bekommst ist halt vorbei :-)
    '**************************************
ScaleMax = 25000
ScaleMin = 0
'**************************************

Bitte um Rückmeldung, welche Methode zum Erfolg führte!
Grüße,
Klaus M.vdT.

AW: Einheitliche Y-Achse
19.06.2013 16:20:47
Jens
Hallo Klaus,
Verzeih mir schlechtes Benehmen. Fühl mich grad richtig schlecht deswegen, wenn du mir deine Hilfe anbietest und ich undankbar wirke, was ich keineswegs bin.
Ich hab die Variante 3 gewählt und es funktioniert alles. Bei den oberen beiden Varianten habe ich jeweils einen Fehler erhalten. Als Wert habe ich mich aber an dem Maximalwert meiner bisherigen Werte von 20050 gehalten.
Grüße
Jens ;)

AW: Einheitliche Y-Achse
19.06.2013 20:46:10
Klaus
Hi Jens,
super wenn es klappt. Ich kenne ja deine ganze Datei nicht, aber vielleicht reicht der fixe Wert dir ja ...
Rein aus Neugier hätte ich das aber gerne gelöst :-) Kannst du aus deiner Datei mal alles ausser Spalte F löschen und die komplett hochladen? Ich vermute, dass es Fehlerwerte in der Spalte gibt welche die MAX-Funktion behindern (vgl. auch mein Dialog mit Rudi). Wenn dem so ist, ist das vielleicht auch für deine rechtliche Auswertung interessant!
Grüße,
Klaus M.vdT.

(.Cells(1, SpalteDaten).EntireColumn)
19.06.2013 16:26:23
Rudi
Hallo,
was liegt näher als
ScaleMax = WorksheetFunction.Max(.Columns(SpalteDaten))
?
Gruß
Rudi

AW: (.Cells(1, SpalteDaten).EntireColumn)
19.06.2013 20:41:04
Klaus
Hallo Rudi,
wenn mein
ScaleMax = WorksheetFunction.Max(.Cells(1, SpalteDaten).EntireColumn)
nicht funktioniert, wird dein
ScaleMax = WorksheetFunction.Max(.Columns(SpalteDaten))
das gleiche Problem haben, oder?
Ich nehme an, in der Masterdatei kommt irgendwo ein #NV oder ein #DIV/0 vor, dass die Max-Funktion stört ...
Grüße,
Klaus M.vdT.

AW: (.Cells(1, SpalteDaten).EntireColumn)
19.06.2013 20:49:35
Rudi
Hallo,
das war Kritik an deinem Code. Sieh's positiv.
Gruß
Rudi

AW: (.Cells(1, SpalteDaten).EntireColumn)
19.06.2013 20:59:35
Klaus
Hallo Rudi,
ich bin jetzt verwirrt.
hast du a)
vorgeschlagen, das Problem von Jens mit worksheetfunction.max zu lösen oder
hast du b)
meine Lösung mit .EntireColumn kritisiert, weil ich stattdessen hätte columns(x) nutzen können?
Falls b)
ich habe mir irgendwann angewöhnt cell().entirecolumn und cell().entirerow zu schreiben. Ich finde das übersichtlicher!
Ich trau mich kaum zu fragen ... columns(x) ist bestimmt auch 4-mal so schnelle wie cells(1,4).entirecolumn, oder?
Grüße,
Klaus M.vdT.

b)
19.06.2013 21:52:39
Rudi
Hallo,
Ich finde das übersichtlicher!
sehe ich nicht so.
columns(x) ist bestimmt auch 4-mal so schnelle wie cells(1,4).entirecolumn
so krass ist es nicht.
Letztlich ist es immer am schnellsten, Objekte direkt anzusprechen. Also anstatt die gesamte Spalte einer Zelle zu ermitteln, direkt die Spalte ansprechen.
Das schlimmste ist die [A1]-Schreibweise.
Sub aaaa()
Dim i, s, t
t = Timer
For i = 1 To 100000
s = Columns(1).Address
Next
Debug.Print "1:", Timer - t
t = Timer
For i = 1 To 100000
s = Cells(1, 1).EntireColumn.Address
Next i
Debug.Print "2:", Timer - t
t = Timer
For i = 1 To 100000
s = Columns("A").EntireColumn.Address
Next i
Debug.Print "3:", Timer - t
t = Timer
t = Timer
For i = 1 To 100000
s = [A:A].Address
Next i
Debug.Print "4:", Timer - t
For i = 1 To 100000
s = [A1].EntireColumn.Address
Next i
Debug.Print "5:", Timer - t
End Sub

Gruß
Rudi

AW: b)
20.06.2013 13:03:41
Klaus
Hallo Rudi,
Letztlich ist es immer am schnellsten, Objekte direkt anzusprechen.
den Satz werde ich heute nachmittag 100 mal an die Tafel schreiben :-)
Vielen Dank nochmal und schöne Grüße,
Klaus M.vdT.

AW: Diagramm automatisch erstellen
19.06.2013 12:47:54
Jens
Perfekt DANKE!!!
Eine Frage nur noch: Gibt es eine Möglichkeit, dass die erzeugten Diagramme breiter dargestellt werden und nicht so gequetscht sind? (momentan 72 Zeilen hoch,6 Spalten breit).

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige