Clever-Excel-Forum

Hallo liebe Mitglieder,

nachdem mir heute rasend schnell von 2 sehr freundlichen Mitgliedern geholfen wurde, bin ich so mutig und schildere auch noch mein 2. Problem:

Eine Tabelle enthält sehr viele Einträge (über 15.000 Zeilen). In Tabelle "Quelldatei" stehen die Daten.

Ein Datenblock beginnt immer in Spalte "A" mit einem Eintrag "Data No."., der nächste Block beginnt ebenfalls wieder mit "Data No." in Spalte "A". Nun würde ich von jedem der sehr, sehr vielen Blöcke (final rund 200) ein Diagramm benötigen, welche in X -Achse die Werte aus Spalte "B" und als Linie die Werte aus Spalte "C" (AVE(Ev)) wiedergibt.

Die Diagramme sollten als Titel jeweils den Straßennamen tragen (steht immer in der Zelle oberhalb der Zelle mit dem Inhalt "Data No.)
Das so oft, bis die Quelltabelle bis zum Ende durchgesucht wurde.

Diese Diagramme sollten im Tabellenblatt "Diagramme" erstellt werden um diese von dort aus dann später als PDF zu drucken.

Eine Beispieldatei (mit wenigen Demo Daten) füge ich bei.

[attachment=42521]

Ich hoffe, 2. Fragen/Probleme an einem Abend ist nicht zuviel und ich bin wirklich sehr dankbar für eure Unterstützung und sage schon mal DANKE!

Viele Grüße
Detlef

Hi

Wie sollen die Diagramme aussehen bzw. auf dem Blatt angeordnet werden(3 Stück untereinander oder 2X3 oder ???). Größe? Legende?
Etwas Vorleistung müsste noch kommen, sonst ist nachher wieder zu viel zu ändern.

Gruß Elex

Ich fürchte du hast eene Aufgabe bekommen für die deine Kenntnisse nicht ausreichen.
Dann wäre es besser einen Dienstleister zu beauftragen.

Schick wäre es doch dabei, "industriell" zu denken:

Statt die 200 Diagramme noch alle in Excel zu erzeugen und dann in einem Rutsch zu drucken (PDF), könnte man doch gleich nur ein einzelnes Diagramm (oder soviele, wie auf eine PDF-Seite kommen) als Seite drucken.

Hallo

- Ich hab mal ein XY Diagramm gewählt
- Deine X -Achsenwerte sind Text. Die solltest du in ein Datum TT.MM.JJJJ hh:mm:ss umwandeln

Hier mal ein erster Entwurf

Code:
Sub Diagramme_erstellen()

    Dim TB As Worksheet, DB As Worksheet, DName As String, Anz As Long, Von As Long, Bis As Long

    Dim firstAddress As String, c As Variant, LR As Long

    Dim Off As Integer

    Dim Breite As Double, Hoehe As Double, Abst As Double

    Set TB = Sheets("Quelltabelle")

    DName = "Diagramme"

    Breite = 400    'Diagrammbreite

    Hoehe = 200     'Diagrammhöhe

    Abst = 1.1      'Abstandsfaktor zwischen den Diagrammen

    Off = 5         'ZeilenOffset von "Data No" bis vorheriges Ende

    'altes Blatt löschen und Neues anlegen

    If Not IsError(Evaluate(DName & "!A1")) Then

        Application.DisplayAlerts = False

            Sheets(DName).Delete

        Application.DisplayAlerts = False

    End If

    Set DB = Sheets.Add(After:=Sheets(Sheets.Count))

    DB.Name = DName

    Von = 2 'Startzeile

    LR = TB.Cells(TB.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte

    With TB.Columns(1)

        Set c = .Find(What:="Data No.", After:=.Cells(Von, 1), LookIn:=xlValues, _

            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

        If Not c Is Nothing Then

            firstAddress = c.Address

            Do

                Bis = c.Row - Off

                If Bis < Von Then Bis = LR 'Wichtig beim Letzten Fund

                'neues Diagramm erzeugen

                DB.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers, 10, Hoehe * Anz * Abst, Breite, Hoehe).Select

                With ActiveChart

                    'Datenbereich festlegen

                    .SetSourceData Source:=TB.Cells(Von + 1, 2).Resize(Bis - Von, 2)

                    'Diagrammtitel

                    .ChartTitle.Text = TB.Cells(Von - 1, 1)

                End With

                'nächstes

                Anz = Anz + 1

                Von = c.Row ' neue Startzeile

                Set c = .FindNext(c)

            Loop While Not c Is Nothing And c.Address <> firstAddress

        End If

    End With

    MsgBox Anz & " Diagramme eingefügt."

End Sub

LG UweD

Dedl

Elex

snb

LCohen

UweD