Microsoft Excel

Herbers Excel/VBA-Archiv

VBA Bereich für dynamsiches Diagramm verschieben


Betrifft: VBA Bereich für dynamsiches Diagramm verschieben
von: Arnd-Olav
Geschrieben am: 12.12.2018 08:52:24

Guten Morgen,

ich habe ein Diagramm, dass mir jeweils Daten auf Basis der letzten 6 Monate anzeigt.

Die Daten werden monatlich aktualisiert. Die jeweilige Monatsspalte wird mit den Daten aufgefüllt.

Jetzt bin ich soweit, dass ich herrausgefunden habe den Bereich zu verschieben, siehe Code unten, nur leider packt er mir die drei Berieche (siehe Scrennshot im JPG Anhang) zu einem zusammen.

Ich möchte aber nur die Datenbereiche verschieben und nicht den Beschriftungsbereich, und das Layout des Diagramms (auch im JPG) soll so bleiben wie es ist.

Weiß jemand Rat?

Sub Makro1()
'
Dim lngLetzteSpalte As Long
Dim chDiagramm As Chart

Set chDiagramm = Worksheets(1).ChartObjects("Diagramm 1").Chart

lngLetzteSpalte = Cells(6, Columns.Count).End(xlToLeft).Column
  
With Range("B15:B20")
  Cells(6, lngLetzteSpalte + 1).Resize(.Rows.Count, 1) = .Value
End With
    
With chDiagramm
  .SetSourceData Source:=Tabelle1.Range(Cells(5, lngLetzteSpalte - 4), Cells(10,  _
lngLetzteSpalte + 1)), PlotBy:=xlColumns
End With

End Sub


  

Betrifft: AW: VBA Bereich für dynamsiches Diagramm verschieben
von: Dieter Klemke
Geschrieben am: 12.12.2018 10:01:44

Hallo Arnd-Olav,

lade doch einfach mal eine Beispieldatei hoch. Werte können beliebig verändert und/oder anonymisiert sein.

Viele Grüße
Dieter


  

Betrifft: AW: VBA Bereich für dynamsiches Diagramm verschieben
von: Arnd-Olav
Geschrieben am: 12.12.2018 10:10:34

Hier ist eine Beispieldatei

http://www.herber.de/bbs/user/126040.xlsm


  

Betrifft: AW: VBA Bereich für dynamsiches Diagramm verschieben
von: Dieter Klemke
Geschrieben am: 12.12.2018 11:33:37

Hallo Arnd-Olav,

ich gehe davon aus, dass die letzte Monatsspalte gefüllt ist.
Dann kannst du das Programm starten und es zeigt dir die letzten 6 Monate an.

Sub Diagramm_darstellen()
  Dim ch As Chart
  Dim i As Long
  Dim lngLetzteSpalte As Long
  Dim rngMonate As Range
  Dim rngWeek As Range
  Dim ser As Series
  Dim strBezeich As String
  Dim strBlatt As String
  Dim strMonate As String
  Dim strWerte As String
  Dim wb As Workbook
  Dim ws As Worksheet
  
  Set wb = ThisWorkbook
  Set ws = wb.Worksheets(1)
  strBlatt = "'" & ws.Name & "'!"
  lngLetzteSpalte = ws.Cells(6, ws.Columns.Count).End(xlToLeft).Column
  If lngLetzteSpalte < 7 Then Exit Sub
  Set rngMonate = ws.Cells(5, lngLetzteSpalte).Offset(0, -5).Resize(1, 6)
  strMonate = rngMonate.Address
  Set rngWeek = ws.Range("A5")
  Set ch = ws.ChartObjects(1).Chart
  i = 1
  For Each ser In ch.SeriesCollection
    strBezeich = rngWeek.Offset(i, 0).Address
    strWerte = rngMonate.Offset(i, 0).Address
    ser.Formula = "=SERIES(" & strBlatt & strBezeich & "," & strBlatt & strMonate & "," & _
                  strBlatt & strWerte & "," & i & ")"
    i = i + 1
  Next ser
End Sub

Viele Grüße
Dieter

http://www.herber.de/bbs/user/126044.xlsm


  

Betrifft: AW: VBA Bereich für dynamsiches Diagramm verschieben
von: Arnd-Olav
Geschrieben am: 12.12.2018 14:40:34

Danke für deine Mühe, das Diagramm berührt nun aber nur die Reihe 10.

Könnte man den Code

 ser.Formula = "=SERIES(" & strBlatt & strBezeich & "," & strBlatt & strMonate & "," & _
                  strBlatt & strWerte & "," & i & ")"

nicht auch hier in die unterste Zeile reinbekommen?
    ActiveSheet.Shapes.Range(Array("Group 4")).Select
    ActiveSheet.ChartObjects("Diagramm 2").Activate
    ActiveChart.PlotArea.Select
    ActiveChart.SetSourceData Source:=Range( _
        "'Übersicht ALL Natcos'!$A$40,'Übersicht ALL Natcos'!$M$40:$R$40,'Übersicht ALL Natcos'! _
$A$45:$A$51,'Übersicht ALL Natcos'!$M$45:$R$51" _



  

Betrifft: AW: VBA Bereich für dynamsiches Diagramm verschieben
von: Dieter Klemke
Geschrieben am: 12.12.2018 17:02:20

Hallo Arnd-Olav,

was meinst du mit Reihe 10?
Deine Arbeitsmappe 126040.xlsm enthielt 10 Diagramme, nur dasjenige welches mit der linken oberen Ecke in der Zelle V1 liegt, war in deiner Fragestellung angesprochen. Ich habe die 9 übrigen entfernt und dir die Mappe 126044.xlsm mit dem einen Diagramm und dem VBA-Programm zurückgeschickt.
Funktioniert das Programm in dieser Arbeitsmappe nicht?
Wenn du das Programm in deiner Arbeitsmappe 126040.xlsm verwenden willst, dann musst du die Zeile
Set ch = ws.ChartObjects(1).Chart
durch die folgende ersetzen
Set ch = ws.ChartObjects("Chart 1").Chart
damit das richtige Diagramm angesprochen wird.

Viele Grüße
Dieter


  

Betrifft: AW: VBA Bereich für dynamsiches Diagramm verschieben
von: Dieter Klemke
Geschrieben am: 12.12.2018 17:37:29

Hallo Arnd-Olav,

da du so hartnäckig bist, habe ich das noch einmal probiert.
Es geht tatsächlich einfacher und zwar folgendermaßen

Sub Diagramm_darstellen_2()
  Dim ch As Chart
  Dim letzteSpalte As Long
  Dim rngBezeich As Range
  Dim rngWerte As Range
  Dim wb As Workbook
  Dim ws As Worksheet
  
  Set wb = ThisWorkbook
  Set ws = wb.Worksheets(1)
  letzteSpalte = ws.Cells(6, ws.Columns.Count).End(xlToLeft).Column
  If letzteSpalte < 7 Then Exit Sub
  Set rngWerte = ws.Cells(5, letzteSpalte).Offset(0, -5).Resize(6, 6)
  Set rngBezeich = ws.Range("A5:A10")
  Set ch = ws.ChartObjects("Chart 1").Chart
  ch.SetSourceData Source:=Union(rngBezeich, rngWerte)
End Sub
Viele Grüße
Dieter


  

Betrifft: AW: VBA Bereich für dynamsiches Diagramm verschieben
von: Arnd-Olav
Geschrieben am: 13.12.2018 20:00:48

Hallo Dieter,

vielen Dank für deine Hilfe. So hat es geklappt :)

Gruß aus Hamburg


  

Betrifft: AW: VBA Bereich für dynamsiches Diagramm verschieben
von: Arnd-Olav
Geschrieben am: 12.12.2018 15:05:17

Lässt sich dies nicht auch so irgendwie lösen???

Dim ch As Chart
  Dim i As Long
  Dim lngLetzteSpalte As Long
  Dim r1 As Range
  Dim r2 As Range
  Dim r3 As Range
  Dim ser As Series
  
lngLetzteSpalte = Cells(6, Columns.Count).End(xlToLeft).Column
  
With Range("B15:B20")
  Cells(6, lngLetzteSpalte + 1).Resize(.Rows.Count, 1) = .Value
End With

Set r1 = Tabelle1.Range(Cells(6, 1), Cells(10, 1))
Set r2 = Tabelle1.Range(Cells(5, lngLetzteSpalte - 4), Cells(5, lngLetzteSpalte + 1))
Set r3 = Tabelle1.Range(Cells(6, lngLetzteSpalte - 4), Cells(10, lngLetzteSpalte + 1))

With ch
    ActiveSheet.Shapes.Range(Array("Group 4")).Select
    ActiveSheet.ChartObjects("Diagramm 2").Activate
    ActiveChart.PlotArea.Selec
    ActiveChart.SetSourceData = ser.Formula = "=Series(" & r1 & ", " & r2 & ", " & r3 & ")"
End With



  

Betrifft: Besser ohne VBA mit dynamischen Namen.
von: Daniel
Geschrieben am: 12.12.2018 15:27:39

Hi
das kannst du besser ohne VBA lösen, mit dynamischen Namen (Namen mit berechnetem Zellbereich)

lege erstmal einen Namen für die Zeilen fest (Formel immer bei "Bezieht sich auf" eingtragen):
den Tabellennamen habe ich vereinfacht, weil ich zu faul zum Tippen bin, den kannst du ja ergänzen:

DQ_Gesamt: =Übersicht!$5:$11
DQ_Ausschnitt: =INDEX(DQ_Gesamt;0;ANZAHL2(INDEX(DQ_Gesamt;2;0))-4):INDEX(DQ_Gesamt;0;ANZAHL2(INDEX(DQ_Gesamt;2;0))+1)
und dann für jede Datenreihe des Diagramms:
DQ_A: =Index(DQ_Ausschnitt;2;0)
DQ_B: =Index(DQ_Ausschnitt;3;0)
DQ_C: =Index(DQ_Ausschnitt;4;0)
usw für alle benötigten Datenreihen und die Überschrift:
DQ_ÜB: =Index(DQ_Ausschnitt;1;0)

diese Namen passen sich dann alle automatsich an, wenn du in der Datentabelle den nächsten Monat befüllst.

im Diagramm klickst du dann auf "Werte auswählen" und trägst anstelle des fixen Zellbezugs den entsprechenden Namen ein.
Beachte, dass du immer den Dateinamen voranstellen musst: ='126040.xlsm'!DQ_A

wenn du das für alle Datenreihen incl. Überschrift gemacht hast, sollte sich auch dein Diagramm immer automatsich an die befüllten Monate anpassen.

wenn du mehr oder weniger Monate anzeigen lassen willst, musst du das nur im Namen DQ_Ausschnitt anpassen, die anderen Namen bauen darauf auf.

Gruß Daniel