Office: (Office 2010) VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten

Guten Morgen Karin,

Das hat leider noch nicht geklappt :-(
Die Tabellen werden genauso erstellt wie vorher.
Die Zeile 'lngZeile = .ChartObjects(.ChartObjects.Count).BottomRightCell.Row + 2' sagt ihm ja, dass er den rechten unteren Rand der Grafik als Bezug nehmen soll, oder? Aber irgendwie scheint er das nicht erfassen zu können.
Es sieht jedenfalls weiterhin aus wie in meinem Screenshot...

Hast du noch eine andere Idee? Oder muss man noch irgendwas modifizieren?

Vielen Dank für deine großartige Unterstützung weiterhin!

Beste Grüße,
Jan

 

Hi Jan,

do müsste es jettz korrekt sein:

Code:

            End With
            DoEvents
            If lngAnzahl < 11 Then
                lngZiel = .ChartObjects(.ChartObjects.Count).BottomRightCell.Row + 2
            Else
                lngZiel = lngZiel + lngAnzahl + 3
            End If
        End With
        lngZeile = lngZeile + Application.CountIf(Columns(1), Cells(lngZeile, 1)) - 1
    Next lngZeile
    Application.ScreenUpdating = True
End Sub

Bis später,
Karin

 

Weltklasse!
Jetzt funktioniert alles! :D

Vielen, vielen Dank Karin!

Ich weiß es ist viel verlangt, aber ich hätte noch zwei weitere Fragen, wobei ich die natürlich auch nochmal gesondert ins Forum laden kann. Aber eventuell kannst du mir da ja auch noch weiterhelfen...?
1) Ich würde gerne die Blöcke farblich voneinander abheben. Das habe ich jetzt schon getan indem ich alle geraden Abrufe blau gefärbt habe.
An der Grenze zwischen zwei Bauteilen gibt es dann aber Probleme, da das Ventil bspw. mit Abruf Nr. 1 endet (ungerade; =weiss) und die Buche mit Abruf Nr. 7 beginnt (ungerade; =weiss). Hier geht der farbliche Abhebung verloren.
Gibt es eine Möglichkeit die Blöcke, unabhängig von gerade oder ungerade, einfach abwechselnd zu färben?

2) Meine zweite Frage ist etwas komplexer.
Ich habe eine neue Datei angehängt ('Excel Forum 2'), mit der gleichen Excel-Liste. Nur jetzt sind noch die Spalten 'Status' (Sp M), 'letztes fixes Datum' (Sp N) und 'letztes fixes Datum alter Abruf' (Sp O) hinzugekommen.
Ich hätte gerne das aktuellste Datum mit dem Status "Fix" in jeder Zeile.
Einmal für den aktuellen Abruf und einmal für den letzten Abruf.

Beispiel 1:
In jeder Zeile der Abruf-Nr. 6 (Zeile 2-17) des Ventils wäre in Spalte N nichts eingetragen, da der komplette Abruf 6 kein fixes Datum enthält.
In Spalte O wäre dann der 12.08.2016 eingetragen, da das das aktuellste Datum mit Status "Fix" im Abruf 5 ist.

Beispiel 2:
In jeder Zeile der Abruf-Nr. 5 (Zeile 18-42) des Ventils wäre in der Spalte N der 12.08.2016 eingetragen und in Spalte O der 05.08.2016 aus Abruf-Nr. 4.

Meinst du das kann funktionieren?

Allerbeste Grüße,
Jan

 

Hi Jan,

da die beiden Fragen nichts mit dem vorhergehenden Thema zu tun haben, würde ich dich bitten, einen neuen Thread zu erstellen, sonst geht die Übersichtlichkeit im Forum verloren.

Bis später,
Karin

 

Okay, da hast du Recht.
Ich habe zwei neue Themen erstellt.

Vielen lieben Dank nochmal für deine Hilfe Karin!

Beste Grüße,
Jan

 

Hi Karin,

Ich habe doch nochmal eine Frage, und zwar zum Modifizieren des Graphen.
Ich möchte gerne die Farben der Linien verändern und gleichzeitig die eine Linie in der Vordergrund bringen.
Bisher sieht der Graph so aus:

Und ich möchte dort hin:

Ich habe auch schon einen Code, der aber nicht so richtig funktioniert.
Und da hatte ich gehofft du kannst mir nochmal helfen.

Der erste Abschnitt soll dafür sorgen das die Cum. Qty. In den Vordergrund rücken.
Ich möchte die Spalten in der Tabelle nebenan aber nicht verändern, deshalb wollte ich einfach die Reihenfolge der Erstellung ändern.
Alt:

Code:

       With .ChartObjects.Add(0, 0, 0, 0).Chart
                .ChartType = xlLineMarkers
                .SetSourceData Source:=Range("Results!I" & lngZiel - 1 & ":K" & lngZiel + lngAnzahl), PlotBy:=xlColumns
                Range("Results!F" & lngZiel & ":F" & lngZiel + lngAnzahl).NumberFormat = "dd/mm/yyyy"
                .SeriesCollection(1).XValues = Range("Results!F" & lngZiel & ":F" & lngZiel + lngAnzahl)
                .Parent.Top = .Parent.Parent.Cells(lngZiel - 1, 14).Top
                .Parent.Left = .Parent.Parent.Cells(lngZiel, 14).Left
            'die Abmaße sind modifiziert
                .Parent.Height = 240
                .Parent.Width = 420
                .Legend.Position = xlBottom
            
            End With

Meine Modifikationen:
Erster Versuch (alles in einem, aber einfach andere Reihenfolge):

Code:

.SetSourceData Source:=Range(("Results!I" & lngZiel - 1 & ":I" & lngZiel + lngAnzahl) & ("Results!K" & lngZiel - 1 & ":K" & lngZiel + lngAnzahl) & ("Results!J" & lngZiel - 1 & ":J" & lngZiel + lngAnzahl)), PlotBy:=xlColumns

Zweiter Versuch (nacheinander, aber einfach andere Reihenfolge):

Code:

 .SetSourceData Source:=Range("Results!I" & lngZiel - 1 & ":I" & lngZiel + lngAnzahl), PlotBy:=xlColumns
            .SetSourceData Source:=Range("Results!K" & lngZiel - 1 & ":K" & lngZiel + lngAnzahl), PlotBy:=xlColumns
            .SetSourceData Source:=Range("Results!J" & lngZiel - 1 & ":J" & lngZiel + lngAnzahl), PlotBy:=xlColumns

Im zweiten Abschnitt möchte ich dann die Farben verändern. Da meckert er aber ebenfalls rum.
Ich bin in der With-Schleife die zur Erstellung des Graphen genutzt wird geblieben um die Zuordnung eindeutig zu machen.
Meine Modifikation:

Code:

       .SeriesCollection(1).Select
                With Selection.Format.Line
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 0, 0)
                End With
                With Selection.Format.Fill
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 0, 0)
                End With
                With Selection.Format.Line
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 0, 0)
                End With
                With Selection
                    .MarkerStyle = 2
                    .MarkerSize = 5
                End With
                
                .SeriesCollection(2).Select
                With Selection
                    .MarkerStyle = 1
                    .MarkerSize = 5
                End With
                With Selection.Format.Fill
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = RGB(0, 112, 192)
                End With
                With Selection.Format.Line
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = RGB(0, 112, 192)
                End With
                With Selection.Format.Fill
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = RGB(0, 112, 192)
                End With
                With Selection.Format.Line
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = RGB(0, 112, 192)
                End With
                
                .SeriesCollection(3).Select
                With Selection.Format.Line
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = msoThemeColorAccent2
                End With
                With Selection.Format.Fill
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = msoThemeColorAccent2
                End With
                With Selection.Format.Line
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = msoThemeColorAccent2
                End With
            
            End With

Das End With am Ende ist noch von der Erstellung des Graphen.

Schonmal vorab vielen Dank für deine Geduld mit mir!

Beste Grüße,
Jan

 

Hi Jan,

wenn die Datenreihen eine andere Reihenfolge als die Spalten haben sollen, dann erstellst du am besten zuerst ein leeres Diagramm und fügst dann die einzelnen Datenreihen in der gewünschten Reihenfolge ein. Ich habe den Code jetzt nicht getestet, aber so sollte es eigentlich funktionieren:

Code:

    With ActiveSheet.ChartObjects.Add(0, 0, 0, 0).Chart
         .ChartType = xlLineMarkers
         .Parent.Top = .Parent.Parent.Cells(lngZiel - 1, 14).Top
         .Parent.Left = .Parent.Parent.Cells(lngZiel, 14).Left
         .Parent.Height = 240
         .Parent.Width = 420
         .Legend.Position = xlBottom
         .SetSourceData Source:=Range("A1"), PlotBy:=xlColumns
         ' Falls A1 belegt ist und deshalb das Diagramm eine Datenreihe enthält -> diese löschen
         If .SeriesCollection.Count > 0 Then .SeriesCollection(1).Delete
         Range("Results!F" & lngZiel & ":F" & lngZiel + lngAnzahl).NumberFormat = "dd/mm/yyyy"
         With .SeriesCollection.NewSeries
            .XValues = Range("Results!F" & lngZiel & ":F" & lngZiel + lngAnzahl)
            .Values = Range("Results!I" & lngZiel & ":I" & lngZiel + lngAnzahl)
            With .Format.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
            End With
            With .Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
            End With
            .MarkerStyle = 2
            .MarkerSize = 5
         End With
         With .SeriesCollection.NewSeries
            .XValues = Range("Results!F" & lngZiel & ":F" & lngZiel + lngAnzahl)
            .Values = Range("Results!K" & lngZiel & ":K" & lngZiel + lngAnzahl)
            With .Format.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 112, 192)
            End With
            With .Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 112, 192)
            End With
            .MarkerStyle = 1
            .MarkerSize = 5
         End With
         With .SeriesCollection.NewSeries
            .XValues = Range("Results!F" & lngZiel & ":F" & lngZiel + lngAnzahl)
            .Values = Range("Results!J" & lngZiel & ":J" & lngZiel + lngAnzahl)
            With .Format.Line
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorAccent2
            End With
            With .Format.Fill
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorAccent2
            End With
         End With
     End With

Bis später,
Karin

 

Ach Karin,
wieder mal perfekt!!

Vielen Dank für deine Hilfe! :-)

Beste Grüße,
Jan

 

Ach Karin, alle Tage wieder...
Mir ist heute leider noch ein kleines Problem aufgefallen.
Ich hoffe du kannst mir hierbei nochmal, und hoffentlich in diesem Bezug zum letzten Mal, helfen.

Und zwar ist es so, dass ab einer gewissen Anzahl von Stellen innerhalb der 'Verkettung 2' (die ja Grundlage für die Erstellung der Graphen ist) ein Problem entsteht.
Das Programm unterscheidet dann nämlich nicht mehr und kopiert alle Zeilen, auch die darauf folgenden Abruf-Nr., in den Graphen.
Also er vermischt die Abruf-Nummern miteinander, bzw. setzt sie untereinander in einen Graphen.

Bilder sagen mehr als Worte, hier mal ein Screenshot:


Ich hänge diesem Eintrag noch meine modifizierte 'Excel-Forum-Neu' Datei an.
Darin habe ich die Bestellposition (Sp D) 4-stellig und die Abruf-Nr. (Sp G) 2-stellig gemacht. Somit verlängert sich die 'Verkettung 2' und der Fehler tritt auf.

Mein erster Verdacht war, dass es am Format liegt. Das hat aber nichts gebracht.

Ich hoffe wirklich sehr, dass du mir nochmal helfen kannst.

Allerbeste Grüße,
Jan

 

Hi Jan,

das Problem liegt nicht im Code sondern in Excel selbst begründet bzw. in den Zellinhalten der Spalte B: schreibe mal in eine Zelle die Formel =ZÄHLENWENN(B:B;B2) - das Ergebnis ist 65!! und nicht 16. Die Zellinhalte sind ja eigentlich 15-stellige Zahlen - Excel kann m.W. jedoch nur mit maximal 13-stelligen Zahlen korrekt umgehen, folglich das falsche ZÄHLENWENN()-Ergebnis. Weshalb in deiner Mappe nur bei bestimmten Zahlenkombinationen falsch gezählt wird, kann ich dir nicht sagen. Stünde nur mindestens an 1 Position ein Buchstabe, würde der Fehler nicht auftreten - schreibe mal anstelle 5590005417100112 z.B. 559000541710011A - schon ist das Ergebnis von ZÄHLENWENN() korrekt. Die Anzahl darf also nicht mittels ZÄHLENWENN() bzw. in VBA Application.CountIf() ermittelt werden - man kann stattdessen eine Schleife verwenden. Das bremst zwar den Code etwas aus, lässt sich hier aber leider nicht umgehen:

Code:

    'Spalte enger machen
    Worksheets("Tabelle2").Columns("E:E").ColumnWidth = 3
    
    For lngZeile = 2 To lngLetzte
        With Worksheets("Tabelle2")
[COLOR=#ff0000]            For lngEnde = lngZeile To lngLetzte
                If Cells(lngEnde + 1, 2) <> Cells(lngEnde, 2) Then Exit For
            Next lngEnde[/COLOR]
            lngAnzahl = lngEnde - lngZeile
            Range("L1:O1").Copy .Cells(lngZiel, 6)

Übrigens: mann muss eine Tabelle nicht zur aktiven machen, um die Spaltenbreite zu ändern - du kannst also auf Select verzichten, weil es eben unnötig ist (habe es im Code geändert).


Bis später,
Karin

 

Hi Karin,

Nicht dass du dich wunderst. Ich habe die vergangenen 2 Wochen genutzt und alle möglichen Varianten von Daten ausprobiert.
Ich habe das Programm also auf Herz und Nieren getestet, damit ich das Thema nicht wieder für beendet erkläre, bevor es dann ein anderes kleines Problem gibt.
Jedenfalls kann ich jetzt sagen: es funktioniert alles bestens! Einfach super!!
Vielen, vielen Dank nochmal für deine Hilfe!

Eine Idee kam mir aber noch, als Version 2.0 sozusagen:
Bisher ist es ja so, dass das Programm die aktuellste Lieferabrufnr. (kurz: LAnr.) mit der vorherigen vergleicht.
Meinst du es ist auch möglich, dass man in ein Fenster ein Datum eingibt und das Programm diesem Datum eine LAnr. aus der Vergangenheit zuordnet und die identifizierte LAnr. dann mit der aktuellen LAnr. vergleicht?
Als Beispiel bei dem Ventil: man gibt das Datum "13.07.2016" ein. Das Programm erkennt die erste LAnr. die vor diesem Datum liegt (LAnr. 10 mit Erstelldatum 11.07.2016) und vergleicht dann die LAnr. 10 mit der aktuellsten, der LAnr. 12.
Meinst du sowas ist möglich?

Falls wir bis dahin nichts mehr voneinander "hören" wünsche ich dir schonmal besinnliche Weihnachten!
Beste Grüße,
Jan

 

Hi Jan,

so richtig verstehe ich nicht, was du da machen willst und ein Datum 13.07.2016 gibt es nicht.

Bis später,
Karin

 

Grüß dich Karin,

Zunächst einmal wünsche ich dir ein frohes und gesundes neues Jahr! :)

Nun zu meinem Problem:
Also bisher vergleicht das Programm ja nur die aktuellste Lieferabrufnr. mit der vorherigen Nr., also der zweit-aktuellsten Nr..

Nun wäre es zusätzlich noch super, wenn der Nutzer als seinen "letzten Stand" sozusagen, einfach ein Datum eingeben kann.
Beispielsweise gibt der Nutzer den ’13.07.2016’ ein.
Dieses Datum trifft auf keine Lieferabrufnr. zu.
Aber das Programm soll nun das erste Datum das chronologisch VOR dem eingegebenen Datum liegt ODER GLEICH ist, auswählen und mit der aktuellsten Lieferabrufnr. vergleichen.

Erstmal nur für das Ventil:
Also der Nutzer gibt das Datum '13.07.2016' ein,
das Programm identifiziert den '11.07.2016' von Lieferabrufnr. 10 als erstes Datum das chronologisch VOR dem 13.07.2016 liegt (am dichtesten dran sozusagen),
wählt diese Lieferabrufnr. 10 aus,
und vergleicht sie mit der aktuellsten Lieferabrufnr., der 12.

Bezogen auf die anderen beiden Teile:
Bei der Buche identifiziert das Programm die Lieferabrufnr. 4 ('11.07.2016') und vergleicht sie mit der aktuellsten, der Nr. 7.

Beim Lager identifiziert das Programm die Lieferabrufnr. 3 ('04.07.2016') und vergleicht sie wieder mit der aktuellsten, der Nr. 9.

Wirklich vielen Dank für die Geduld und Hilfe!

Beste Grüße,
Jan

 

Hi Jan,

und wie soll der Vergleich mit der aktuellsten Nr. aussehen? Ich habe nach wie vor keine Ahnung was du erreichen willst.

Bis später,
Karin

 

Hi Karin,

Danke für deine schnelle Antwort!
Der Vergleich soll genauso aussehen wie bisher, also mit generierter Tabelle und Graph.

Das visualisierte Ergebnis soll vom Aufbau her gleich bleiben, nur mit dem Unterschied, dass nicht mehr nur die aktuellste mit der zweit-aktuellsten Nr. verglichen wird, sondern die aktuellste Nr. mit einer durch die Datums-Eingabe bestimmten Nr. verglichen wird.
Letzendlich bleibt es aber bei einem Vergleich von zwei Lieferabrufnummern.
Weißt du was ich meine?

Beste Grüße,
Jan