Office: Diagramme - automatisiert

Hallo Leute,
Habe eine Frage zur Automatisierung der Diagrammdarstellung in Excel. Ein Grafik der Tabelle:



Ich habe in Zeilen Verlaufsdaten zu einer ID mit je 3 Items pro Datum: D,A,S. Jetzt will ich Diagramme erstellen: für jede ID soll es 3 Diagramme geben, die jeweils die einzelnen D-,A- und S-Scores (Y) im Zeitverlauf (X) erstellen, wie in der Grafik beispielhaft an einem Datensatz dargestellt.
Die eigtl. Tabelle umfasst ca 200 IDs mit bis zu 50 Daten a 3 Items. Ich muss also 600 Diagramme erstellen und frage mich nun, wie sich das maximal beschleunigen lässt? Das muss man doch irgendwie skripten können, oder zumindest sowas wie ein Makro schreiben?
Meine bisher effizienteste Methode ist die manuelle Markierung der einzelnen Items

Wisst ihr vielleicht, wie das schneller geht?

Grüße, thomas[/img]

 

Hi Thomas,

es gibt natürlich die Möglichkeit, alle Diagramme per VBA zu erstellen, allerdings wäre es schöner, statt eines Bildes die Datei selbst zur Verfügung zu haben - da lässt sich ein Code viel besser testen.

Bis später,
Karin

 

Hallo Karin,
vielen Dank für Deine Antwort :) Leider hab ich keinen Plan von VBA-Scripts Ich habe die Datei mal hochgeladen:
http://dl.dropbox.com/u/585608/Mappe1.xls

Grüße, Thomas

EDIT: Die Grafik und die Excel-Tabelle sind nur ein Beispiel zur Veranschaulichung - die Originaltabelle umfasst zig mehr Daten, die vor und nach den D,A,S-Werten liegen. Zum erstellen der Diagramme könnte ich diese Zellen aber löschen.

 

*push*

Sorry, dass ich jetzt nochmal pushe, aber ich verzweifle an der Aufgabe -.-
Habe ein Makro aufgezeichnet, dass mir zumindest schonmal das Diagramm für die D-Werte von ID1 ausgeben kann, aber ich hab keine Ahnung wie ich das auf den Rest der Tabelle anwenden kann

Code:

Sub Diagramme_D()
'
' Diagramme_D Makro
' Makro am 17.03.2010 von Benutzer aufgezeichnet
'

'
    ActiveCell.Offset(0, 3).Range("A1,E1,I1,M1").Select
    ActiveCell.Offset(0, 15).Range("A1").Activate
       ActiveCell.Offset(0, -12).Range("A1,E1,I1,M1,Q1,U1,Y1,AC1").Select
    ActiveCell.Offset(0, 16).Range("A1").Activate
   
    ActiveCell.Offset(0, -28).Range("A1,E1,I1,M1,Q1,U1,Y1,AC1,AG1,AK1,AO1").Select
    ActiveCell.Offset(0, 12).Range("A1").Activate
   
    ActiveCell.Offset(0, -40).Range("A1,E1,I1,M1,Q1,U1,Y1,AC1,AG1,AK1,AO1,AS1"). _
        Select
    ActiveCell.Offset(0, 4).Range("A1").Activate
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range( _
        "D3,H3,L3,P3,T3,X3,AB3,AF3,AJ3,AN3,AR3,AV3"), PlotBy:=xlRows
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle2"
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Depression"
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
    End With
End Sub

Niemand?

Grüße, Thomas B.

 

Hi Thomas,

sorry, konnte leider nicht eher antworten.

Code:

Sub DiasErstellen()
    Dim chDiagramm As ChartObject
    Dim loZeile As Long
    Dim doOben As Double
    doOben = Range("A10").Top
    For loZeile = 3 To IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
        Set chDiagramm = ActiveSheet.ChartObjects.Add(0, doOben, 300, 150)
        With chDiagramm.Chart
            .ChartType = xlColumnClustered
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Formula = "=SERIES(""Depressio"",,(Tabelle1!" & _
                Cells(loZeile, 3).Address & ",Tabelle1!" & Cells(loZeile, 7).Address & _
                ",Tabelle1!" & Cells(loZeile, 11).Address & _
                ",Tabelle1!" & Cells(loZeile, 15).Address & "),1)"
            .HasTitle = True
            .ChartTitle.Characters.Text = "D"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Score"
        End With
        Set chDiagramm = ActiveSheet.ChartObjects.Add(300, doOben, 300, 150)
        With chDiagramm.Chart
            .ChartType = xlColumnClustered
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Formula = "=SERIES(""Depressio"",,(Tabelle1!" & _
                Cells(loZeile, 4).Address & ",Tabelle1!" & Cells(loZeile, 8).Address & _
                ",Tabelle1!" & Cells(loZeile, 12).Address & _
                ",Tabelle1!" & Cells(loZeile, 16).Address & "),1)"
            .HasTitle = True
            .ChartTitle.Characters.Text = "A"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Score"
        End With
        Set chDiagramm = ActiveSheet.ChartObjects.Add(600, doOben, 300, 150)
        With chDiagramm.Chart
            .ChartType = xlColumnClustered
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Formula = "=SERIES(""Depressio"",,(Tabelle1!" & _
                Cells(loZeile, 5).Address & ",Tabelle1!" & Cells(loZeile, 9).Address & _
                ",Tabelle1!" & Cells(loZeile, 13).Address & _
                ",Tabelle1!" & Cells(loZeile, 17).Address & "),1)"
            .HasTitle = True
            .ChartTitle.Characters.Text = "S"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Score"
        End With
        doOben = doOben + 150
    Next loZeile
End Sub

Bis später,
Karin

 

Wow Karin :shock: paar zeilen angepasst und es rennt!

Wahnsinn, Danke!

Habt ihr einen Spendenaccount? :)

Lg, thomas

 

Hi Thomas,

besuche einfach ab und zu mal meine HP (steht in meinem Profil) - dann bin ich schon zufrieden ;-)

Bis später,
Karin