letzte beiden Filterkriterien auswählen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub LastTwoEntriesFilter() Const FILTER_COLUMN As Long = 1 Const FILTER_ROW As Long = 1 Dim avntValues As Variant, vntItem As Variant Dim objArrayList As Object With Tabelle1 avntValues = .Range(.Cells(FILTER_ROW + 1, FILTER_COLUMN), _ .Cells(.Rows.Count, FILTER_COLUMN).End(xlUp)) Set objArrayList = CreateObject(Class:="System.Collections.ArrayList") For Each vntItem In avntValues If Not objArrayList.Contains(vntItem) Then Call objArrayList.Add(vntItem) Next Call objArrayList.Sort Call .Rows(FILTER_ROW).AutoFilter(Field:=FILTER_COLUMN, Criteria1:= _ Array(objArrayList.Item(objArrayList.Count - 1), _ objArrayList.Item(objArrayList.Count - 2)), _ Operator:=xlFilterValues) Set objArrayList = Nothing End With End Sub

Hallo Nepumuk,
der Code klappt perfekt.
Vielen lieben Dank.
Ich habe nun versucht diesen Code anzupassen auf meinen Filter von der Pivot Tabelle.
Leider bekomme ich aber Fehlermeldungen.


Public Sub LastTwoEntriesFilter()
Const FILTER_COLUMN As Long = 1
Const FILTER_ROW As Long = 1
Dim avntValues As Variant, vntItem As Variant
Dim objArrayList As Object
With Worksheets("overview").PivotTables("pivot_overview").PivotFields("Datum")
avntValues = .Range(.Cells(FILTER_ROW + 1, FILTER_COLUMN), _
.Cells(.Rows.Count, FILTER_COLUMN).End(xlUp))
Set objArrayList = CreateObject(Class:="System.Collections.ArrayList")
For Each vntItem In avntValues
If Not objArrayList.Contains(vntItem) Then Call objArrayList.Add(vntItem)
Next
Call objArrayList.Sort
Call .Rows(FILTER_ROW).AutoFilter(Field:=FILTER_COLUMN, Criteria1:= _
Array(objArrayList.Item(objArrayList.Count - 1), _
objArrayList.Item(objArrayList.Count - 2)), _
Operator:=xlFilterValues)
Set objArrayList = Nothing
End With
End Sub

Option Explicit Sub test() Dim i As Long With Worksheets("overview").PivotTables("pivot_overview").PivotFields("Datum").PivotItems For i = 1 To .Count - 2 .Item(i).Visible = False Next For i = .Count - 1 To .Count .Item(i).Visible = True Next End With End Sub

Option Explicit Sub test() Dim i As Long With Worksheets("overview").PivotTables("pivot_overview").PivotFields("Datum").PivotItems For i = .Count - 1 To .Count .Item(i).Visible = True Next For i = 1 To .Count - 2 .Item(i).Visible = False Next End With End Sub

Sub test() With Worksheets("overview").PivotTables("pivot_overview").PivotFields("Datum") For i = .PivotItems.Count - 1 To .PivotItems.Count .PivotItems(i).Visible = True Next For i = 1 To .PivotItems.Count - 2 .PivotItems(i).Visible = False Next End With End Sub

Sub DeleteOldPivotItemsWS() 'ungültige Pivot-Items entfernen 'Pivot-Items die mal vorhanden waren und aus dem Datenstamm wegfallen werden aus 'der Pivot-Tabelle selbst nicht automatisch entfernt. Dim pt As PivotTable Dim pf As PivotField Dim pi As PivotItem Application.ScreenUpdating = False On Error Resume Next With Worksheets("overview") For Each pt In .PivotTables pt.RefreshTable For Each pf In pt.PivotFields For Each pi In pf.PivotItems If pi.RecordCount = 0 And Not pi.IsCalculated Then pi.Delete End If Next pi Next pf Next pt End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

letzte beiden Filterkriterien auswählen

25 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

25
Beiträge zum Forumthread

Beiträge zu diesem Forumthread