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

Helfe beim Thema VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo liebe Office-Hilfe.com-Gemeinde, Ich habe dieses Forum ausgewählt, da ich hier den Eindruck von echtem Fachwissen gepaart mit gutem Umgang... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Jan1234, 9. November 2016.

  1. Jan1234 Erfahrener User

    VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten


    Hallo liebe Office-Hilfe.com-Gemeinde,
    Ich habe dieses Forum ausgewählt, da ich hier den Eindruck von echtem Fachwissen gepaart mit gutem Umgang miteinander vorfinde.
    Und nach zahlreichen passiven Besuchen zur Selbstbildung in Richtung VBA ist dies ist mein erster Eintrag, da ich nun nicht mehr weiterkomme.

    Zum Hintergrund: es geht um Lieferpläne.

    Ich habe folgendes Problem:
    Ich habe eine Tabelle aufbereitet die aus mehreren Blöcken besteht (Level: siehe Spalte A 'Verkettung 1'). Ein solcher Block ergibt sich aus einer 'Bestellnummer' und einer 'Bestellposition'. Also hier z.B. das Ventil.
    Innerhalb eines solchen Blocks gibt es chronologische Abrufnummern (Sp. G). Aus dieser Information ergibt sich die ‚Verkettung 2‘ (Sp. B).
    Die Abrufnr. (Sp. G) zeigt den einen Abruf mit all seinen Lieferdaten.
    Ich habe es nach Größe sortiert – also oben steht der aktuellste Abruf, in diesem Fall der 6. Abruf (das bedeutet, der Lieferplan hat sich schon 6 mal geändert).

    Nun möchte ich aus dieser Excel-Tabelle eine graphische Übersicht erstellen. Und zwar für den aktuellsten Abruf einer ‚Verkettung 1‘. Also den maximalen Wert der ‚Verkettungen 2‘ innerhalb der ‚Verkettung 1‘.
    Dabei sollen alle Lieferdaten und kumulierten Mengen (Neu & Alt) übernommen werden, um sie dann graphisch zu vergleichen.
    Im Ergebnis hätte ich dann gerne alle Graphen mit Übersichten von den verschiedenen Bauteilen untereinander in einem neuen Arbeitsblatt (variable Länge der Lieferpläne und damit varibler Startpunkt des nächsten Graphen). VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten Excel_Forum.jpg

    Ich habe schon ein Makro aufgezeichnet das für den ersten Block macht was ich möchte, aber ich bekomme es nicht hin es zu verallgemeinern.
    Es müsste ja irgendwie folgende Definition sein: Wenn sich 'Verkettung 1' ändert, dann ersten Block der nächsten Verkettung übernehmen.

    Ich bedanke mich schon einmal vorab für mögliche Antworten!

    Ps.: eine weitere Frage habe ich zu der Färbung. Ich habe es hier nur hinbekommen, dass ich Zeilen mit gerade Abrufnummern blau färbe, so ergibt sich aber, wie auch hier, dann ein Sprung zwischen den Bestellnummern. Wie kann man das lösen?
     
    Zuletzt bearbeitet: 9. November 2016
    Jan1234, 9. November 2016
    #1
  2. Beverly
    Beverly Erfahrener User
    Hi,

    und wo ist dein aufgezeichnetes Makro?

    Bis später,
    Karin
     
  3. Jan1234 Erfahrener User
    Hallo Karin,
    Vielen Dank für deine Antwort.

    Ich hoffe meine Problembeschreibung war nicht zu detailliert - ist vllt etwas viel Background dabei.
    Worum es mir zusammengefasst geht, ist ein kleines Programm, dass mir erlaubt, diese Übersicht mit Graphen und Tabellen für die verschiedenen Bauteile (Ventil usw.) untereinander darzustellen. Das Problem dabei ist, dass die Tabellen aufgrund der Lieferplaneigenschaften unterschiedlich lang sein können. Die Graphen und Tabellen müssten also variable Startpunkte haben.

    Ich hoffe sehr auf deine Hilfe, ich komme echt nicht weiter ... :-(
     
  4. Jan1234 Erfahrener User

    VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten

    Hier ist mein Makro für das Erstellen der Tabelle und des Graphen:

    Sub Tabelle_und_Graph()
    '
    ' Tabelle_und_Graph Makro
    '

    '
    Sheets("Tabelle1").Select
    Range("L1:O1").Select
    Selection.Copy
    Sheets("Tabelle2").Select
    Range("F4").Select
    ActiveSheet.Paste
    Sheets("Tabelle1").Select
    Application.CutCopyMode = False
    Range("L2:O17").Select
    Selection.Copy
    Sheets("Tabelle2").Select
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("F4:I20").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    Range("F4:H20").Select
    ActiveSheet.Shapes.AddChart2(332, xlLineMarkers).Select
    ActiveChart.SetSourceData Source:=Range("Tabelle2!$F$4:$H$20")
    ActiveSheet.Shapes("Diagramm 2").IncrementLeft 276
    ActiveSheet.Shapes("Diagramm 2").IncrementTop -27
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "Kumulierte Menge Neu"
    Range("G5").Select
    End Sub
     
  5. Jan1234 Erfahrener User
    Und hier das Makro für die Erstellung der Übersicht (hier schon auf english):
    (VORSICHT, beim kopieren des Makros beachten: ich musste bei allen Zeilen mit der Spalte D ein Leerzeichen einfügen, da er mir da sonst überall Smilies einsetzt)

    Sub Results_Maske_NEU()
    ' Results_Maske_NEU Makro
    Dim ersterBlock As Long
    Dim i, w_flag As Long
    Dim Counter, rep_cnt As Long

    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Order No."
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Order Pos."
    Range("C3: D3").Select
    ActiveCell.FormulaR1C1 = "Article Description"
    Range("C4: D4").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge
    Range("C5").Select
    ActiveCell.FormulaR1C1 = "Current"
    Range("D5").Select
    ActiveCell.FormulaR1C1 = "Replaced"
    Range("B6").Select
    ActiveCell.FormulaR1C1 = "Del. Instr. No."
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "Del. Instr. Date"
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "Revision"
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "latest fix Date"
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "Cum. Del. Qty. C."
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "Latest"
    Range("C12").Select
    ActiveCell.FormulaR1C1 = "Del.note Date"
    Range("B12").Select
    ActiveCell.FormulaR1C1 = "Del.note No."
    Range("D12").Select
    ActiveCell.FormulaR1C1 = "Del.note Qty."
    Range("A12").Select
    With Selection
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Range("A3: D3").Select
    Selection.Font.Bold = True
    Range("C5: D5").Select
    Selection.Font.Bold = True
    Range("B6:B10").Select
    Selection.Font.Bold = True
    Range("B5: D10").Select
    Range("A12: D13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    Range("B5: D10").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    Range("A3: D3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A3: D4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Range("A3: D13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D: D").EntireColumn.AutoFit
    Columns("A:A").EntireColumn.AutoFit
    Columns("A:A").ColumnWidth = 11.29
    Range("A3:B4").Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent4
    .TintAndShade = 0.799981688894314
    .PatternTintAndShade = 0
    End With
    Range("C5: D10").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    End Sub
    Sub Results_Graph()
    '
    ' Results_Graph Makro
    '

    'Maske fuellen
    Sheets("Tabelle1").Select
    Range("C2").Select
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("F2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("C4: D4").Select
    ActiveSheet.Paste
    Sheets("Tabelle1").Select
    ActiveWindow.SmallScroll ToRight:=2
    Range("I2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("C6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("K2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("J2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("C7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("L2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("D7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("C8").Select
    Sheets("Tabelle1").Select
    Range("G2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("M2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("D8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("V2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("W2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("D9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("C7: D7,C9:D9").Select
    Range("C9").Activate
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy"
    Sheets("Tabelle1").Select
    Range("Q2").Select
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("C10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("R2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("D10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("N2:P2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("B13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("C13").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy"
    Range("D13").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With

    'Tabelle und Graph erstellen
    Columns("E:E").ColumnWidth = 3.43
    Sheets("Tabelle1").Select
    ActiveWindow.SmallScroll Down:=-18
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    Range("S2:S17").Select
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("F4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("F3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Del. Date"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "Cum. Qty. Current"
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "Cum. Qty. Repl."
    Range("I3").Select
    ActiveCell.FormulaR1C1 = "Delta"
    Range("G3").Select
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Range("F3:I3").Select
    Range("I3").Activate
    Selection.Font.Bold = True
    Sheets("Tabelle1").Select
    Range("AC2:AC17").Select
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("G4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("AD2:AD17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("H4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Tabelle1").Select
    Range("AE2:AE17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle3").Select
    Range("I4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("F:F").Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("F3:I19").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
    End With
    Range("J3").Select
    Columns("J:J").ColumnWidth = 3.71
    Range("F3:H19").Select
    ActiveSheet.Shapes.AddChart2(332, xlLineMarkers).Select
    ActiveChart.SetSourceData Source:=Range("Tabelle3!$F$3:$H$19")
    'ActiveSheet.Shapes("Diagramm 2").IncrementLeft 178.5
    'ActiveSheet.Shapes("Diagramm 2").IncrementTop -149.25

    End Sub
     
  6. Beverly
    Beverly Erfahrener User
    Hier mein Lösungsvorschlag:

    Code:
    Sub DiaTabErstellen()
        Dim lngLetzte As Long
        Dim lngZiel As Long
        Dim lngEnde As Long
        Dim lngZeile As Long
        Dim lngAnzahl As Long
        lngZiel = 4
        lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
        Application.ScreenUpdating = False
        For lngZeile = 2 To lngLetzte
            With Worksheets("Tabelle2")
                lngEnde = lngZeile + Application.CountIf(Columns(2), Cells(lngZeile, 2)) - 1
                lngAnzahl = lngEnde - lngZeile
                Range("L1:O1").Copy .Cells(lngZiel, 6)
                .Cells(lngZiel, 7) = .Cells(lngZiel, 7).Value & " Neu"
                lngZiel = lngZiel + 1
                Range(Cells(lngZeile, 12), Cells(lngEnde, 15)).Copy
                .Cells(lngZiel, 6).PasteSpecial Paste:=xlValues
                With .ChartObjects.Add(0, 0, 0, 0).Chart
                    .ChartType = xlLineMarkers
                    .SetSourceData Source:=Range("Tabelle2!G" & lngZiel - 1 & ":H" & lngZiel + lngAnzahl), PlotBy:=xlColumns
                    Range("Tabelle2!F" & lngZiel & ":F" & lngZiel + lngAnzahl).NumberFormat = "dd/mm/yyyy"
                    .SeriesCollection(1).XValues = Range("Tabelle2!F" & lngZiel & ":F" & lngZiel + lngAnzahl)
                    .Parent.Top = .Parent.Parent.Cells(lngZiel - 1, 11).Top
                    .Parent.Left = .Parent.Parent.Cells(lngZiel, 11).Left
                    .Parent.Height = 180
                    .Parent.Width = 300
                    .Legend.Position = xlBottom
                End With
                DoEvents
            End With
            lngZeile = lngEnde
            lngZiel = lngZiel + lngAnzahl + 3
        Next lngZeile
        Application.ScreenUpdating = True
    End Sub

    Code muss ausgeführt werden wenn Tabelle1 aktiv ist.

    Bis später,
    Karin
     
  7. Jan1234 Erfahrener User
    Hi Karin,

    Vielen Dank für deine Hilfe! Das Licht am Ende des Tunnels wird heller und heller :D
    Dein Code funktioniert schon einmal super und macht was er soll.

    Kannst du mir jetzt noch dabei helfen, dass nur die aktuellste Abrufnummer kopiert wird?
    Also beim Ventil beispielsweise nur der Block mit der Abrufnr. '6' (Sp G), bei der Buchse nur die '7' (Sp G) und beim Lager nur die '9'.

    Meiner Meinung nach gibt es da zwei Möglichkeiten (wahrscheinlich findest du noch eine bessere):
    - man kopiert nur den Block mit dem maximalen Wert in Sp. G unter der Voraussetzung, dass 'Verkettung 1' gleich bleibt
    oder
    - man kopiert den ersten Block (das ist möglich, weil die Blöcke sortiert sind) von 'Verkettung 1'

    Wirklich vielen Dank!

    Beste Grüße,
    Jan
     
  8. Beverly
    Beverly Erfahrener User

    VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten

    Hi Jan,

    ich habe den Code nach deiner Mappe geschrieben, also immer die zusammenhängenden Blöcke werden kopiert - wenn du das jetzt anders haben möchtest, musst du den Code entsprechend anpassen. Andere Möglichkeit: du kopierst alle Daten, für die Diagramme erstellt werden sollen in eine Hilfstabelle und lässt den Code dann darüber laufen.

    Bis später,
    Karin
     
  9. Jan1234 Erfahrener User
    Hi Karin,

    Nochmals Danke für deine Antwort.

    Dass die zusammenhängenden Blöcke kopiert werden ist super und auch richtig so.
    Daran möchte ich nichts ändern.
    Ich bräuchte nur die Möglichkeit, dass das Programm immer nur den aktuellsten Block, also den aktuellsten Lieferplanabruf, kopiert und daraus den Graphen erstellt. Für das Ventil wären dass dann "nur" die Zeilen 2-17.
    Insgesamt müsste das Programm dann für meine hochgeladene Beispieldatei nur 3 Graphen produzieren.
    Weißt du was ich meine?

    Echt vielen Dank für deine Zeit und Geduld!

    Beste Grüße,
    Jan
     
  10. Beverly
    Beverly Erfahrener User
    Hi Jan,

    ändere diese Zeile

    Code:
    lngZeile = lngEnde


    in diese

    Code:
    lngZeile = lngZeile + Application.CountIf(Columns(1), Cells(lngZeile, 1))

    Bis später,
    Karin
     
  11. Jan1234 Erfahrener User
    Hi Karin,

    Das ist jetzt schon super nah dran.
    Beim Ventil funktioniert alles perfekt!
    Allerdings scheint sich bei der weiteren Auswahl etwas zu verschieben.
    Denn bei der Buchse werden in der Tabelle statt den Zeilen 114-127, die Zeilen 115-128 übernommen.
    Beim Lager werden statt den korrekten Zeilen 222-231, die Zeilen 224-233 übernommen.
    Der Bereich scheint sich also immer n+1 zu verschieben. Also bei der Buchse dann insgesamt nur +1, beim Lager dann schon +2.

    Weißt du woran das liegen könnte?

    1000 Dank nochmal für deine tolle Unterstützung.

    Beste Grüße,
    Jan
     
  12. Beverly
    Beverly Erfahrener User
    Hi Jan,

    ergänze bei der geänderten Zeile am Ende noch - 1

    Ich hatte nicht berücksichtigt, dass durch Next lngZeile der Zähler lngZeile nochmal um 1 erhöht wird.

    Bis später,
    Karin
     
  13. Jan1234 Erfahrener User

    VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten

    Hi Karin,

    Perfekt!! Alles funktioniert! :D
    Und ich konnte es super adaptieren.

    Vielen, vielen Dank Karin!

    Beste Grüße,
    Jan
     
  14. Jan1234 Erfahrener User
    Hi Karin,

    Mir ist leider noch ein Problem aufgefallen und ich hoffe du kannst mir nochmal helfen...
    Und zwar gibt es Lieferpläne die kürzer sind als bei den 3 Beispielen die ich hochgeladen habe.
    Dadurch ergibt sich dann eine Überlappung bei den Graphen (z.B. liegt der nächste Graph zum Teil dann über dem Vorherigen usw.)

    Hier mal ein Screenshot, damit du siehst was ich meine:
    VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten Unbenannt.jpg

    Gibt es eine Möglichkeit, dass das Ende der erstellten Tabelle ODER das Ende des Graphen genommen wird um dann den Abstand zum nächsten Lieferplan zu erstellen (also je nachdem was länger ist)?

    Ich hoffe sehr auf deine nochmalige Hilfe :)

    Beste Grüße,
    Jan
     
    Zuletzt bearbeitet: 17. November 2016
  15. Beverly
    Beverly Erfahrener User
    Hi Jan,

    ersetze diese Zeilen

    Code:
                End With
                DoEvents
            End With
            lngZeile = lngEnde
            lngZiel = lngZiel + lngAnzahl + 3
        Next lngZeile
        Application.ScreenUpdating = True
    End Sub
    
    

    durch diese

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

    Bis später,
    Karin
     
Thema:

VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten

Die Seite wird geladen...
  1. VBA Graph erstellen mit wechselnden unterschiedlich langen Abschnitten - Similar Threads - VBA Graph erstellen

  2. VBA: Spalten auf anderen Worksheeds in der Mappe ausblenden.

    in Microsoft Excel Hilfe
    VBA: Spalten auf anderen Worksheeds in der Mappe ausblenden.: Hallo zusammen, Eine Tabelle mit 9 Worksheets, Datenblatt, Studien, Studie_1 ...Studie_7. Auf dem Deckblatt werden in Zelle B4-B10 die Namen der Studien eingetragen. Davon abhängig ob ein Name...
  3. VBA Zeilen kopieren mit Bedingung

    in Microsoft Excel Hilfe
    VBA Zeilen kopieren mit Bedingung: Hallo zusammen, Ich möchte per Makro Zeilen aus Tabelle2 in Tabelle3 kopieren, wenn eine Bedingung erfüllt ist. Bedingung: Der Wert in Spalte E (Tabelle2) kommt in Tabelle1 in Spalte E vor....
  4. VBA - Datensätze ans Ende einer anderen Tabelle kopieren

    in Microsoft Excel Hilfe
    VBA - Datensätze ans Ende einer anderen Tabelle kopieren: Hallo zusammen, ich habe gerade eine "Abrechnungs"-Datei für einen Kindergartenbasar erstellt. Es wäre klasse, wenn man per Schaltfläche die Datensätze aus der Tabelle "Kaeufer" ans Ende der...
  5. Laufzeitfehler 9 VBA

    in Microsoft Excel Hilfe
    Laufzeitfehler 9 VBA: Nschdem ich die Office Version von 2010 auf 2019 aktualisiert habe wird mir der Laufzeitfehler 9 ausgegeben. Das ist der Code Sub FiberCollect() Dim NumRows As Long 'letzte celle Dim Counter As...
  6. Excel VBA Spalten mit Ordnerinhalt vergleichen

    in Microsoft Excel Hilfe
    Excel VBA Spalten mit Ordnerinhalt vergleichen: Hallo, Bin ehr Excel VBA Neuling, Würde aber gerne in einer bestehender Tabelle die Auflistung der Ordner mit dem eigentlichen Stand in den besagten Ordner kontrollieren. Also in der Spalte Q10...
  7. VBA - letzte nicht-leere Spalte

    in Microsoft Excel Hilfe
    VBA - letzte nicht-leere Spalte: Moin, liebe VBA-Spezis, mit Cells(99, Columns.Count).End(xlToLeft).Column bestimme ich die Spaltenzahl der letzten benutzten Zelle in Zeile 99. Soweit, so klar. Nun habe ich aber Formeln in...
  8. Excel Graph mittels Activex Checkbox steuern - VBA Code

    in Microsoft Excel Hilfe
    Excel Graph mittels Activex Checkbox steuern - VBA Code: Hallo zusammen, der Inhalt meiner Excel Graphen ändert sich in Abhängigkeit von dem, was in zwei von einander abhängigen Dropdowns (Kombinationsfelder- Form Control) selektiert wird. Hierbei...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden