Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1896to1900
1896to1900
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

letzte beiden Filterkriterien auswählen

Forumthread: letzte beiden Filterkriterien auswählen

letzte beiden Filterkriterien auswählen
06.09.2022 11:31:18
Henry
Hallo liebes Forum,
ich würde gerne mittels VBA die letzten beiden Einträge bzw. Filterkriterien bei einem Filter auswählen.
Die Filterliste ändert sich laufend und die Filtereinträge auch.
Ist so etwas möglich?
LG
Henry
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 12:11:40
Nepumuk
Hallo Henry,
um was handelt es sich bei den Einträgen? Text, Zahl, Datum?
Gruß
Nepumuk
AW: letzte beiden Filterkriterien auswählen
06.09.2022 12:12:39
Henry
Hallo Nepumuk,
es handelt sich um Text.
Vg
Henry
AW: letzte beiden Filterkriterien auswählen
06.09.2022 12:27:57
Nepumuk
Hallo Henry,
teste mal:

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
Gruß
Nepumuk
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 12:35:08
Henry
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

Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 12:54:43
Nepumuk
Hallo Henry,
da kann ich dir, ohne die Mappe, nicht weiterhelfen.
Gruß
Nepumuk
AW: letzte beiden Filterkriterien auswählen
06.09.2022 13:18:22
Nepumuk
Hallo Henry,
sorry, aber damit kenne ich mich nicht aus. Ich lass die Frage offen.
Gruß
Nepumuk
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 13:40:00
peterk
Hallo

With Worksheets("Tabelle2").PivotTables("pivot_overview").PivotFields("Datum")
For i = 1 To .PivotItems.Count - 2
.PivotItems(i).Visible = False
Next
End With
Peter
AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:15:48
Henry
Hallo Peter,
vielen Dank für den Code.
Nun wird im Filter immer die letzte Position ausgewählt, aber leider nicht die letzten beiden.
Kannst du mir hier nochmal helfen.
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:20:28
Henry
Kleiner Nachtrag.
In der Beispieldatei klappt dein Code.
Aber leider nicht in der echten Datei.
AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:25:15
Henry
Sobald in der Basistabelle mehrere Werte stehen, zum Beispiel 07_22 und 08_22, wird nur noch auf den letzten Wert gefiltert.
Siehe Datei:
https://www.herber.de/bbs/user/155009.xlsm
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:30:53
Rudi
Hallo,
vorher alle Filter löschen.

    With Worksheets("Tabelle2").PivotTables("pivot_overview").PivotFields("Datum")
.ClearAllFilters
For i = 1 To .PivotItems.Count - 2
.PivotItems(i).Visible = False
Next
End With

AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:36:54
Henry
Leider tut sich nichts.
Es wird weiterhin nur der letzte Wert ausgewählt.
Anzeige
geht bei mir. owT
06.09.2022 14:40:40
Rudi
AW: geht bei mir. owT
06.09.2022 14:49:41
Henry
In der Beispieldatei klappt es.
Nur in der echten Tabelle geht es nicht.
Komisch, weil beide ähnlich sind.
aber nur ähnlich :-( owT
06.09.2022 14:52:32
Rudi
Anzeige
AW: geht bei mir. owT
06.09.2022 14:57:53
Daniel
In dem Fall müsstest du schauen, was du beim Erstellen der Beispieldatei gegenüber der Echtdatei verändert hast, und dann diese Änderungen auch bei der Echtdatei vornehmen.
Da du das ja schon beim Erstellen der Beispieldatei hinbekommen hast, sollte das auch bei der Echtdatei funktionieren.
Gruß Daniel
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:31:48
Nepumuk
Hallo Henry,
teste mal:

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
Gruß
Nepumuk
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:35:43
Henry
Leider bekomme ich einen Laufzeitfehler 1004
AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:38:31
Nepumuk
Hallo Henry,
kann ich nicht nachvollziehen. In deiner Mustermappe funktioniert es einwandfrei.
Gruß
Nepumuk
AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:50:50
peterk
Hallo
Zuerst einschalten , dann ausschalten (wenn alles aus kommt es zum Laufzeitfehler)

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
Peter
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 14:55:30
Henry
Ich verstehe es nicht.
In der Beispieldatei klappt es, in der echten Datei kommt folgender Fehler:
Laufzeitfehler 1004
Die Visible Eigenschaft des PivotItem-Objektes kann nicht festgelegt werden.
:-(
AW: letzte beiden Filterkriterien auswählen
06.09.2022 15:01:44
peterk
Hallo
Folgender Code funktioniert bei mir

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
Peter
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 15:03:11
Rudi
Hallo,
möglicherweise sind ungültige Pivotitems in der Pivottabelle. Das sind Items, die in der Datenquelle nicht mehr vorhanden sind. Ein ganz blödes Verhalten von Pivot-Tabellen.
Vorher das laufen lassen:

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
Gruß
Rudi
Anzeige
AW: letzte beiden Filterkriterien auswählen
06.09.2022 12:56:54
Rudi
Hallo,
Filter in Pivots werden komplett anders behandelt. Hier geht es um die Sichtbarkeit der PivotItems.
Gruß
Rudi
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige