Office: (Office 2010) Großes Projekt mit Filtern/Sverweisen/Teilergebnis/Pivot

Helfe beim Thema Großes Projekt mit Filtern/Sverweisen/Teilergebnis/Pivot in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen, ich habe folgendes Makro aufgezeichnet, möchte es aber nicht nur auf die eine Datei anwenden, sondern jede Woche auf eine aktuelle... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von crunkfox, 21. Februar 2019.

  1. Großes Projekt mit Filtern/Sverweisen/Teilergebnis/Pivot


    Hallo zusammen,

    ich habe folgendes Makro aufgezeichnet, möchte es aber nicht nur auf die eine Datei anwenden, sondern jede Woche auf eine aktuelle mit anderen Werten.

    Könnt ihr mal drüberschauen und es umschreiben?

    Erklärungen sind im Makro drin.

    Code:
    Sub Differenzprotokollbearbeiten()
    '
    ' Differenzprotokollbearbeiten Makro
    '
    
    ' 1. Zeile 1 mit Filter versehen
    ' 2. Alle Zeilen entfernen, wenn in Spalte AF eine 1 drinsteht
        ActiveSheet.Range("$A$1:$AF$124078").AutoFilter Field:=30, Criteria1:="1"
        Rows("78:78").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Range("$A$1:$AF$122264").AutoFilter Field:=30
    ' 3. Spalte A markieren und eine Spalte hinzufügen und mit Überschrift Kennzahl versehen
        Columns("A:A").Select
        Selection.Insert Shift:=xlToRight
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "Kennzahl"
    ' 4. Pivottabelle erstellen ("Zellenbeschriftungen = Filiale / Summe von VK diff ges.")
        Cells.Select
        Sheets.Add
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            "Daten1!R1C1:R1048576C33", Version:=xlPivotTableVersion14).CreatePivotTable _
            TableDestination:="Tabelle1!R3C1", TableName:="PivotTable1", _
            DefaultVersion:=xlPivotTableVersion14
        Sheets("Tabelle1").Select
        Cells(3, 1).Select
        Range("B9").Select
        With ActiveSheet.PivotTables("PivotTable1")
            .InGridDropZones = True
            .RowAxisLayout xlTabularRow
        End With
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("Filiale")
            .Orientation = xlRowField
            .Position = 1
        End With
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("VK diff ges.")
            .Orientation = xlRowField
            .Position = 2
        End With
        Range("A7").Select
        ActiveSheet.PivotTables("PivotTable1").PivotFields("Filiale").Subtotals = Array _
            (False, False, False, False, False, False, False, False, False, False, False, False)
        Range("B9").Select
        ActiveSheet.PivotTables("PivotTable1").PivotFields("VK diff ges.").Subtotals = _
            Array(False, False, False, False, False, False, False, False, False, False, False, False)
        Range("B10").Select
        ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
            "PivotTable1").PivotFields("VK diff ges."), "Anzahl von VK diff ges.", xlCount
        Range("B6").Select
        ActiveSheet.PivotTables("PivotTable1").PivotFields("Anzahl von VK diff ges."). _
            Function = xlSum
        Range("B7").Select
    ' 5. Aufsteigend sortieren in Spalte "Summe von VK diff ges."
        Columns("A:B").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Rows("4:4").Select
        Application.CutCopyMode = False
        Selection.AutoFilter
        ActiveWorkbook.Worksheets("Tabelle1").AutoFilter.Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Tabelle1").AutoFilter.Sort.SortFields.Add Key:= _
            Range("B4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Tabelle1").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    ' 6. In Spalte C zu jeder Filiale eine Kennzahl hinzufügen.
        Range("C6").Select
        ActiveCell.FormulaR1C1 = "1"
        Range("C7").Select
        ActiveCell.FormulaR1C1 = "2"
        Range("C6:C7").Select
        Selection.AutoFill Destination:=Range("C6:C1987")
        Range("C6:C1987").Select
        Range("D8").Select
    ' 7. Per Sverweis im Tabellenblatt "Daten1" die Kennzahlen der Filialen zuordnen
        Sheets("Daten1").Select
        Range("A2").Select
        ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[5],Tabelle1!C:C[2],3,FALSE)"
        Range("A2").Select
        Selection.AutoFill Destination:=Range("A2:A122264")
        Range("A2:A122264").Select
        Rows("1:1").Select
    ' 8. Aufsteigend sortieren in Spalte A ("Kennzahl")
        Selection.AutoFilter
        Selection.AutoFilter
        ActiveWorkbook.Worksheets("Daten1").AutoFilter.Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Daten1").AutoFilter.Sort.SortFields.Add Key:=Range _
            ("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Daten1").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    ' 9. Formeln durch Werte ersetzen
        Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    ' 10.  Teilergebnisse in Spalten N (14) (VK diff ges.) und Z (26) (Diff nach Verbuchung) einfügen. Gruppieren nach: "Filiale" / Unter Verwendung von: "Summe"
        Cells.Select
        Application.CutCopyMode = False
        Selection.Subtotal GroupBy:=6, Function:=xlSum, TotalList:=Array(14, 26), _
            Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ' 11. Gruppierungen entfernen
        Selection.ClearOutline
        Range("J9").Select
        ActiveWindow.SmallScroll Down:=-24
    ' 12. Spalte G markieren und eine Spalte einfügen.
        Columns("G:G").Select
        Selection.Insert Shift:=xlToRight
    ' 13. Mit der Formel Links nur die 8 Stelligen Filialnummern anzeigen lassen. Dann werden die Filialnummern kopiert und als Werte in Spalte F (6) eingefügt.
    '     Dies soll dazu dienen, das Wort "Ergebnis" in den Ergebniszeilen (Teilergebnis) zu entfernen.
        Range("G2").Select
        ActiveCell.FormulaR1C1 = "=+LEFT(RC[-1],8)"
        Range("G2").Select
        Selection.AutoFill Destination:=Range("G2:G124244")
        Range("G2:G124244").Select
        Selection.Copy
        Range("F2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    ' 14. Spalte G wieder entfernen
        Columns("G:G").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft
    ' 15. Nach Ergebniszeilen Filtern (in Spalte D (4) nach Leere Filtern)
        Range("F3").Select
        ActiveSheet.Range("$A$1:$AG$124244").AutoFilter Field:=4, Criteria1:="="
    ' 16. Per Sverweis die Kennzahlen den Filialen in den Ergebniszeilen zuordnen.
        Range("A78").Select
        ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[5],Tabelle1!C:C[2],3,FALSE)"
        Range("A78").Select
        Selection.Copy
        Range("A115:A124245").Select
        ActiveSheet.Paste
        Range("F1951").Select
        Range(Selection, Selection.End(xlDown)).Select
    ' 17. In der letzten Ergebniszeile stand noch das Wort Ergebnis nach der Filialnummer.Ich versteh zwar nicht warum aber das muss entfernt werden.
    '     Damit der Sverweis greift musste die Zelle als Text formatiert werden.
        Range("F124245").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "31309095"
        Range("F124245").Select
        Selection.NumberFormat = "@"
        ActiveCell.FormulaR1C1 = "31309095"
        Range("N124245").Select
        ActiveWindow.SmallScroll Down:=-18
        Range("F121370").Select
        Range(Selection, Selection.End(xlUp)).Select
    ' 18. Alle Ergebniszeilen bis Spalte AE (31) in "Knallrot" / Schriftfarbe "Weiss" und "Fett" formatiert.
        Range("D230").Select
        ActiveWindow.SmallScroll Down:=-33
        Range("A59:AE32831").Select
        ActiveWindow.SmallScroll Down:=-87
        Range(Selection, Selection.End(xlDown)).Select
        ActiveWindow.SmallScroll Down:=24
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = -0.249977111117893
            .PatternTintAndShade = 0
        End With
        With Selection.Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
        ActiveWindow.SmallScroll Down:=-18
        Selection.Font.Bold = True
        Selection.Font.Bold = False
        Selection.Font.Bold = True
        ActiveSheet.Range("$A$1:$AG$124244").AutoFilter Field:=4
        Range("L10").Select
        ActiveWindow.SmallScroll Down:=-39
    ' 19. Spalten N/V/Z als Währung formatieren
        Range("N:N,V:V,Z:Z").Select
        Range("Z1").Activate
        Selection.NumberFormat = "#,##0.00 $"
        Range("S10").Select
    ' 20. Unnötige Spalten entfernen
        Columns("AB:AG").Select
        Selection.Delete Shift:=xlToLeft
        Range("AA1").Select
    End Sub
    
    Vielen Dank im Voraus


    Grüße Emre
     
    crunkfox, 21. Februar 2019
    #1
Thema:

Großes Projekt mit Filtern/Sverweisen/Teilergebnis/Pivot

Die Seite wird geladen...
  1. Großes Projekt mit Filtern/Sverweisen/Teilergebnis/Pivot - Similar Threads - Großes Projekt Filtern

  2. Formel auf andere Zellen unterschiedlicher Größe anwenden

    in Microsoft Excel Hilfe
    Formel auf andere Zellen unterschiedlicher Größe anwenden: Hallo zusammen, ich habe eine Formel gebastelt, die wie angehängt in der Beispiel-Excel zu sehen ist, funktioniert. Kann ich die Formel so vereinfachen, dass ich nicht 3x die angepasste Formel...
  3. Wenn der Wert größer ist als 10 will ich die Differenz in einer Spalte haben

    in Microsoft Excel Hilfe
    Wenn der Wert größer ist als 10 will ich die Differenz in einer Spalte haben: Hallo zusammen, auf dem Bild im Anhang ist mein Zeiterfassungssystem zusehen. Spalte E ist meine Gesamtstundenzahl, wenn diese Zahl größer ist als 10 möchte ich die Differenz daraus in Spalte I...
  4. Zwei gleiche Dateien unterschiedlich groß?

    in Microsoft Excel Hilfe
    Zwei gleiche Dateien unterschiedlich groß?: Hallo, erst einmal einen schönen guten morgen. Ich bin neu hier und hoffe evtl. Hilfe bei meinem Problem zu erhalten :-) Folgendes Problem. Ich erstelle jeden Monat eine PPT (Ja ich weiß es...
  5. Suchfunktion beschleunigen

    in Microsoft Word Hilfe
    Suchfunktion beschleunigen: Hallo, ich habe ein sehr großes Word-Dokument in dem ich sehr oft suche. Die Suche starte ich i.d.R. vom Anfang des Dokuments weil ich dann sehr häufig eine Fundstelle direkt im Inhaltsverzeichnis...
  6. SEHR GROßE ZAHLEN EXPONENZIEREN

    in Microsoft Excel Hilfe
    SEHR GROßE ZAHLEN EXPONENZIEREN: Hallo an alle Experten, gibt es eine Möglichkeit, in Excel Zahlen (sowohl positiv, negativ, auch rational), auch mit deutlich mehr als 20 Kommastellen, zu exponenzieren, und dies auch mit sowohl...
  7. Größe des Zeichnungsbereichs oder der Tortengrafik ändern

    in Microsoft Excel Hilfe
    Größe des Zeichnungsbereichs oder der Tortengrafik ändern: Hallo, ich habe in Excel 2019 einige Tortengrafiken, bei denen die Torten gleich groß sein sollen. Ich kann die Größe des Zeichnungsbereichs über die Ziehpunkte ändern, aber ich möchte präzise...
  8. [VBA] Excel Tabelle via Bookmark nach Word + Größe an Fenster anpassen

    in Microsoft Excel Hilfe
    [VBA] Excel Tabelle via Bookmark nach Word + Größe an Fenster anpassen: Hallo zusammen, kennt jemand einen Kniff, wie ich eine aus Excel kopierte Range (inkl. Formatierung, jedoch ohne Verknüpfung) an die Stelle eines Bookmarks in einem Word-Dokument als neue Tabelle...
  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