Graphik in E2016

[karomue]

Hallo Günther,

zunächst mal danke für die Korrektur, meinte natürlich schon unten rechts...

Deinen Code werde ich schnellstens versuchen nachzuempfinden. Danke. Habe bisher mit Schleifen keine schlechten Erfahrungen gemacht, aber bei mir kommt es auch weder auf Schnelligkeit noch auf minimalem Code an...

Das mit dem "&" meine ich auch schon probiert zu haben, hatte halt nicht den ganzen Versuchscode gepostet. Aber sicher war auch dabei ein syntaktischer Fehler, sonst wäre ja "was" gegangen.

Aber schön, habe ich wieder was dazu gelernt. Muss ich mal meine anderen Makros prüfen, ob ich "deine" Methode nicht auch einsetzen kann.

So, heute ist wieder ein arbeitssamer Tag, 2x Therapie...

Ach ja, unten rechts ist in der letzten Zeile, damit soll ja das gesamte Arbeitsblatt markiert werden. Und natürlich danke ganz allgemein für deine Mühe.

[karomue]

Hm.

Code:

Sub pivot3()
'
' pivot3 Makro
'

'
'i = 2
'Do While Cells(i, 2).Value <> ""
'    i = i + 1
'Loop
'EndTab = i - 1
   Markieren
'    ZelleUntenLinks = "E" & EndTab
   'Range("A1":ZelleUntenLinks).Select
'    Range(Cells("a1"), Cells(ZelleUntenLinks)).Select
   'Range("A1:E21").Select
   Sheets.Add
   ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
       "Tabelle1!R1C1:R21C5", Version:=6).CreatePivotTable TableDestination:= _
       "Tabelle2!R3C1", TableName:="PivotTable1", DefaultVersion:=6
   Sheets("Tabelle2").Select
   Cells(3, 1).Select
   ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
   ActiveChart.SetSourceData Source:=Range("Tabelle2!$A$3:$C$20")
   With ActiveChart.PivotLayout.PivotTable.PivotFields("Datum")
       .Orientation = xlRowField
       .Position = 1
   End With
   ActiveChart.PivotLayout.PivotTable.PivotFields("Datum").AutoGroup
   ActiveChart.PivotLayout.PivotTable.AddDataField ActiveChart.PivotLayout. _
       PivotTable.PivotFields("Sys"), "Summe von Sys", xlSum
   ActiveChart.PivotLayout.PivotTable.AddDataField ActiveChart.PivotLayout. _
       PivotTable.PivotFields("Dia"), "Summe von Dia", xlSum
   ActiveChart.PivotLayout.PivotTable.AddDataField ActiveChart.PivotLayout. _
       PivotTable.PivotFields("Puls"), "Summe von Puls", xlSum
   ActiveChart.PivotLayout.PivotTable.AddDataField ActiveChart.PivotLayout. _
       PivotTable.PivotFields("Sys-Dia"), "Summe von Sys-Dia", xlSum
   Range("A4").Select
   ActiveSheet.PivotTables("PivotTable1").PivotFields("Monate").PivotItems("Jan"). _
       ShowDetail = True
   ActiveSheet.PivotTables("PivotTable1").PivotSelect "Feb", xlDataAndLabel + _
       xlFirstRow, True
   Range("A7").Select
   ActiveSheet.PivotTables("PivotTable1").PivotFields("Monate").PivotItems("Feb"). _
       ShowDetail = True
   Range("A20").Select
   ActiveSheet.PivotTables("PivotTable1").PivotFields("Monate").PivotItems("Dec"). _
       ShowDetail = True
   'Application.Width = 701.25
   'Application.Height = 585
   ActiveSheet.ChartObjects("Diagramm 1").Activate
   ActiveChart.Axes(xlValue).MajorGridlines.Select
   ActiveChart.ChartArea.Select
   ActiveChart.ChartType = xlLine
'    Application.Width = 930
'    Application.Height = 585
   Range("A21").Select
   Selection.Ungroup
   'Selection.Ungroup
   Range("A3:E24").Select
   'Selection.Ungroup
   Selection.ClearContents
   ActiveSheet.ChartObjects("Diagramm 1").Activate
   'Selection.Formula = ""
   ActiveSheet.ChartObjects("Diagramm 1").Activate
   ActiveChart.Legend.Select
   ActiveChart.Legend.LegendEntries(1).Select
   ActiveChart.Legend.LegendEntries(3).Select
   ActiveChart.FullSeriesCollection(1).Name = "=""Sys"""
   ActiveChart.FullSeriesCollection(2).Name = "="" Dia"""
   ActiveChart.FullSeriesCollection(3).Name = "=""Puls"""
   ActiveChart.FullSeriesCollection(2).Name = "=""Dia"""
   ActiveChart.FullSeriesCollection(4).Name = "=""Sys-Dia"""
   ActiveChart.ChartArea.Select
   ActiveSheet.Shapes("Diagramm 1").ScaleWidth 1.4645213655, msoFalse, _
       msoScaleFromBottomRight
   ActiveSheet.Shapes("Diagramm 1").ScaleWidth 1.1842254222, msoFalse, _
       msoScaleFromTopLeft
End Sub
Sub Markieren()
 Dim lRow As Integer
 lRow = Cells(Rows.Count, 5).End(xlUp).Row
 Range("A1:E" & lRow).Select   'Wobei 99% aller Select-Anweisungen flüssiger sind als flüssig (überflüssig)
End Sub

Das läuft soweit gut, wenn ich es im Einzelschritt durchtakte. Lasse ich es laufen, wird die Gruppierung nicht entfernt. Es nutzt auch nichts den Befehl

Code:

Selection.Ungroup

zu wiederholen oder auf den geamten Bereich

Code:

 Range("A3:E24").Select
   'Selection.Ungroup

niochmal auszuführen, das ergibt Fehler. Wie kann man das hinkriegen?

[Rabe]

Hi Karl,

Code:

 Range("A3:E24").Select
   'Selection.Ungroup

Dieser Code kann doch nicht entgruppieren, denn das Entgruppieren ist auskommentiert!

Du führst den Cursor unnötigerweise über das Tabellenblatt, wie einen Hund an der Leine.
Um eine Aktion für einen Bereich anzuwenden, muß dieser nicht markiert/selektiert und dann die Aktion ausgeführt werden, es kann gleich für den Bereich ausgeführt werden ohne Markieren:

Code:

Range("A3:E24").Ungroup

Also zuallererst würde ich mal Deine ganzen Codes auf diese Konstrukte überprüfen und verkürzen, wie Günther schon schrieb, sind die Select-Anweisungen total überflüssig und machen den Code unübersichtlich.

Dann selektierst Du eine Zelle und in der nächsten Zeile wird ein anderer Bereich selektiert. Muß das so sein?

Code:

Cells(3, 1).Select
   ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select

[karomue]

Hallo Ralf,

sorry, da war ich mal wieder zu sparsam.

Code:

Range("A3:E24").Ungroup

war schon nicht auskommentiert, zuerst, erst als es Fehler brachte. So geht entgruppieren leider nicht, das hätte ich besser herausstellen solllen. Das mit cells(3,1).select kann ich jetzt nicht genau erläutern, stammt vom Makro, das aufgezeichnet wurde. Und zwar genau nach euerer Vorgabe zur Erstellung einer Pivot. Select Anweisungen verwende ich gerne - als Anfänger - da  ICH EBEN OFT WISSEN MÖCHTE; WO ICH BIN: mAKROS IM eINZELSCHRITT DURCHZUTAKTEN IST auch so eine Marotte von mir. Sorry für die Großschrift, hat nichts zu bedeuten.

So bleibt es erst einmal bei meiner Frage: entgruppieren geht im Einzelschrii aber nicht wenn man es laufen läßt. Abhilfe wenn möglich wie?

Und: ich finde Pivot erstellen über Makro ist noch einfacher als wie von euch beschrieben, wenn es denn mal lafen würde. Es kann doch nicht sein, dass ein entgruppieren nur im Einzelsdchritt läuft, oder?

[karomue]

Übrigens: falls jemand Ambitionen hätte pivot3 laufen zu lassen, das geht nur, wenn Blutdruck nur mit 1 Tabelle abgespeichert war. Da muss ich dann auch noch nacharbeiten, falls das überhaupt geht, denn nur löschen von weiteren Tabellen geht auch nicht, da sonst das Makro die Tabellen von sich aus die Tab-Nr hochzählt. Nur wenn nur mit 1 Tab abgespeichert war stimmt

Code:

  ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
       "Tabelle1!R1C1:R21C5", Version:=6).CreatePivotTable TableDestination:= _
       "Tabelle2!R3C1", TableName:="PivotTable1", DefaultVersion:=6
   Sheets("Tabelle2").Select

Sheets..., was mit ActiveWorkbook... passiert ist mir leider auch nicht klar. Denn da stehen ja auch (Tabellen-) Bereiche drin.

[Rabe]

Hi Karl,

sorry, da war ich mal wieder zu sparsam.

Code:

Range("A3:E24").Ungroup

Das mit cells(3,1).select kann ich jetzt nicht genau erläutern, stammt vom Makro, das aufgezeichnet wurde. Und zwar genau nach euerer Vorgabe zur Erstellung einer Pivot. Select Anweisungen verwende ich gerne - als Anfänger - da  ICH EBEN OFT WISSEN MÖCHTE; WO ICH BIN: mAKROS IM eINZELSCHRITT DURCHZUTAKTEN IST auch so eine Marotte von mir. Sorry für die Großschrift, hat nichts zu bedeuten.
[...]
Und: ich finde Pivot erstellen über Makro ist noch einfacher als wie von euch beschrieben, wenn es denn mal lafen würde.

Das ist schon klar, daß das cells(3.1) vom Aufzeichnen kommt, da hast Du zwischendrin eben in die Zelle A3 geklickt.
Ich habe jetzt nicht oben nachgeschaut, ob das Makro schon mal da war, aber setze doch mal das ganze aufgezeichnete Makro hier rein, dann können wir Dir zeigen, wie es um den Aufzeichnungsmüll erleichtert werden kann. Das schrittweise Durchtakten und pausieren des Codes mit der STOP-Funktion bleibt davon unbeeinflußt.

Daß das Pivot erstellen mit einem Makrostart einfacher ist, ist ja klar. Aber dann bekommst Du immer nur diese eine Art von Pivot und das passt für andere Aufgaben "nicht immer". Deswegen ist es besser, den längeren Weg zu kennen, weil Du ja (wenn Du auf den Pivot-Geschmack gekommen bist) nicht nur die immer gleiche Pivot verwenden willst, sondern eine, die auf Deine Daten passt.

[karomue]

Hallo Ralf,

das ganze Makro steht in #82 - mit allem "Müll" und Auskommentierungen.

[Rabe]

Hi Karl,

das ganze Makro steht in #82 - mit allem "Müll" und Auskommentierungen.

ich habe versucht, es zusammenzufassen. Teste mal das:

Option Explicit

Sub pivot3()
   ' 
   ' pivot3 Makro 
   ' (c] karomue 
   
   ' 
   
   Application.ScreenUpdating = False     'Anzeige der Bildschirmaktualisierung ausgeschaltet 
   
   Markieren                              'kann raus 
   
   Sheets.Add
   
   ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
       "Tabelle1!R1C1:R21C5", Version:=6).CreatePivotTable TableDestination:= _
       "Tabelle2!R3C1", TableName:="PivotTable1", DefaultVersion:=6
       
   With Sheets("Tabelle2")
      .Shapes.AddChart2(201, xlColumnClustered).Select
      With ActiveChart
         .SetSourceData Source:=Range("Tabelle2!$A$3:$C$20")
         
         With .PivotLayout.PivotTable
            With .PivotFields("Datum")
               .Orientation = xlRowField
               .Position = 1
               .AutoGroup
            End With
            
            .AddDataField .PivotFields("Sys"), "Summe von Sys", xlSum
            .AddDataField .PivotFields("Dia"), "Summe von Dia", xlSum
            .AddDataField .PivotFields("Puls"), "Summe von Puls", xlSum
            .AddDataField .PivotFields("Sys-Dia"), "Summe von Sys-Dia", xlSum
         End With
      End With
      
      With .PivotTables("PivotTable1")
         .PivotFields("Monate").PivotItems("Jan").ShowDetail = True
         .PivotSelect "Feb", xlDataAndLabel + xlFirstRow, True
         .PivotFields("Monate").PivotItems("Feb").ShowDetail = True
         .PivotFields("Monate").PivotItems("Dec").ShowDetail = True
      End With
      
      .ChartObjects("Diagramm 1").Activate
      .ChartObjects("Diagramm 1").Axes(xlValue).MajorGridlines.Select
      .ChartObjects("Diagramm 1").ChartArea.ChartType = xlLine
      
      .Range("A21").Ungroup
      .Range("A3:E24").ClearContents
      
      With .ChartObjects("Diagramm 1")
         .Legend.Select
         .Legend.LegendEntries(1).Select
         .Legend.LegendEntries(3).Select
         .FullSeriesCollection(1).Name = "=""Sys"""
         .FullSeriesCollection(2).Name = "="" Dia"""
         .FullSeriesCollection(3).Name = "=""Puls"""
         .FullSeriesCollection(2).Name = "=""Dia"""
         .FullSeriesCollection(4).Name = "=""Sys-Dia"""
         .ChartArea.Select
      End With
      
      .Shapes("Diagramm 1").ScaleWidth 1.4645213655, msoFalse, msoScaleFromBottomRight
      .Shapes("Diagramm 1").ScaleWidth 1.1842254222, msoFalse, msoScaleFromTopLeft
   End With
   
   Application.ScreenUpdating = True      'Anzeige der Bildschirmaktualisierung eingeschaltet 
   
End Sub

Sub Markieren()                  'zu was wird das noch benötigt? 
   Dim lRow As Integer
   lRow = Cells(Rows.Count, 5).End(xlUp).Row
   Range("A1:E" & lRow).Select   'Wobei 99% aller Select-Anweisungen flüssiger sind als flüssig (überflüssig) 
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

[karomue]

Hallo Ralf,

nein. Läuft leider nicht. Muss mich jetzt aber für unbestimmte Zeit abmelden, denn mit meinem NB stimmt etwas nicht, habe auf C: nur noch knapp 2% frei. Und leider keine Ahnung woran das liegt. Schon massenheft ausgelagert, hilft aber nicht. Dummerweise mal wieder Defrag laufen lassen, das war schon mal nicht gut, jetzt geht aber auch die Systemwiederherstellung nicht mehr, bzw. bringt keinen weiteren Speicherplatz. Sehr unschön.

[GMG-CC]

Moin Charly,

ich habe dir eine PM gesandt!