Makro um automatisch Diagramme zu erzeugen

Hallo liebe Community,
ich habe ein Problem und weiß nicht so recht weiter. Mit Makros und VBA kenne ich mich nur insofern aus, dass ich weiß, dass es sie gibt und vielleicht meine Rettung sein könnten. ;-)
Folgendes Problem habe ich: Ich habe eine Tabelle zugeschickt bekommen, die mehr als 1000 Zeilen hat und aus der ich jede Menge Diagramme erstellen soll. In Spalte A stehen Ländernamen. Diese werden in Spalte B nochmal in unterschiedliche Jahreszahlen (2009-2013) gegliedert. In Spalte C und D werden entsprechende Zahlen zu den Jahren (und dem Land) angezeigt. Diese will ich nun in der Diagrammform "Gestapelte Säule (100%)" darstellen lassen.
Userbild

Das Excel-Sheet hat über 1000 Zeilen und mit jeder sechsten Zeile beginnt wieder ein neues Land mit den Jahren 2009-2013. D.h. würde ich jedem Land manuell ein Diagramm erstellen, wären das über 150 Länder.
Schön wäre es, wenn die Diagramme auch alle sichtbar wären. Alternativ (falls es die Sache in irgendeiner Form einfacher macht) könnte auch jedes Land zunächst in einen Reiter kopiert und anschließend das Diagramm entworfen werden. Hier müsste aber auch der Reiternamen angepasst werden. Weiß nicht, ob das überhaupt funktioniert... ;-)
Ich bedanke mich schon mal im Voraus und hoffe meine Probleme gut geschildert zu haben. =)
Liebe Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Diagramm() ' Diagramm Makro Range("A2:E6").Select ActiveSheet.Shapes.AddChart.Select ActiveChart.ChartType = xlColumnStacked100 ActiveChart.SetSourceData Source:=Range( _ "'Developing Countries, Total'!$A$2:$E$6") End Sub

Hi,

Sub DiasErstellen()
Dim lngLetzte As Long
Dim lngZeile As Long
Dim wksTab As Worksheet
' letzte belegte Zeile in Spalte B ermitteln
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
Count)
' Bildschirmaktualisierung aus
Application.ScreenUpdating = False
With Worksheets("Alle Daten")
' Schleife über alle Zeilen in 5er Schritten
For lngZeile = 2 To lngLetzte Step 5
' Tabellenblatt hinzufügen
Set wksTab = Worksheets.Add
' an die letzte Position schieben
wksTab.Move after:=Worksheets(Worksheets.Count)
' laufenden Zellbereich aus "Alle Daten" in neues Tabellenblatt kopieren
.Range(.Cells(lngZeile, 1), .Cells(lngZeile + 4, 4)).Copy wksTab.Range("A2:D6")
' Überschrift kopieren
.Range("A1:D1").Copy wksTab.Range("A1")
With wksTab
' Name des Tabellenblattes
.Name = .Range("A2")
' Diagramm hinzufügen
With .Shapes.AddChart(0, 0, 0, 0).Chart
.ChartType = xlColumnStacked100
' Wertebereich hinzufügen
.SetSourceData Source:=wksTab.Range("C2:D6")
' Achsenbeschriftung hinzufügen
.SeriesCollection(1).XValues = wksTab.Range("B2:B6")
' Diagramm positionieren
With .Parent
.Top = Range("E3").Top
.Left = Range("E3").Left
.Height = 200
.Width = 350
End With
End With
End With
Next lngZeile
End With
' Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Makro um automatisch Diagramme zu erzeugen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

32 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro um automatisch Diagramme zu erzeugen

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

32 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread