Office: Makro: mehrere Filterkriterien für eine Tabelle per Zellenbezug

Timonbarden · 6. September 2011

Hallo Zusammen,

ich habe eine Tabelle, die ich filtern lassen möchte. Und zwar hängen die Filterkriterien davon ab, was ich halt in Beispielsweise Zelle A4, A5, A6, A7 eingebe. Bleibt ein Filter frei, soll dieser nicht berücksichtigt werden.

Folgenden Code habe ich bereits, der für ein Filterkriterium funktioniert. Für 2 Kriterien habe ich es bereits selbst mal versucht, aber bin leider nicht zum gewünschten Ergebnis gekommen. Vielleicht könnt ihr mir helfen.

Code:

Sub Filtern()
'
' Filtern Makro
'
'
ActiveSheet.ListObjects("Tabelle10").Range.AutoFilter Field:=8,
Criteria1:= _ Range("A4").Text, Operator:=xlFilterValues
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

josef e · 8. September 2011

Hallo Timo,

anbei ein Beispiel.

« Gruß Sepp »

Timonbarden · 8. September 2011

Funktioniert super! Danke *Smilie

Da ich noch 2 weitere Filter haben wollte sieht es nun so aus. Ist das richtig? Ob es nun an dem Code liegt oder woanders dran liegt weiß ich nicht, ihr mit sicherheit aber:

Wenn ich die Datei öffne, werden automatisch insgesamt 3 Dateien geöffnet. Sehen erstmal gleich aus, haben aber leichte unterschiede, als wären das etwas ältere VErsionen. Die Dateinamen lauten dann auch auf einmal z.B.

Dateifilter:1
Dateifilter:2
Dateifilter:3

Wobei der ursprüngliche Name der Datei halt nur "Dateifilter" ist.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim strFilter() As String
Dim lngIndex As Long

If Not Intersect(Target, Range("B5:M7")) Is Nothing Then
With Me
For Each rng In .Range("B5:M7")
If rng "" Then
ReDim Preserve strFilter(lngIndex)
strFilter(lngIndex) = rng.Text
lngIndex = lngIndex + 1
End If
Next

If lngIndex > 0 Then
.ListObjects("Tabelle10").Range.AutoFilter Field:=8, _
Criteria1:=strFilter, Operator:=xlFilterValues
Else
.ListObjects("Tabelle10").Range.AutoFilter Field:=8
End If
End With
End If

If Not Intersect(Target, Range("B8:M10")) Is Nothing Then
With Me
For Each rng In .Range("B8:M10")
If rng "" Then
ReDim Preserve strFilter(lngIndex)
strFilter(lngIndex) = rng.Text
lngIndex = lngIndex + 1
End If
Next

If lngIndex > 0 Then
.ListObjects("Tabelle10").Range.AutoFilter Field:=9, _
Criteria1:=strFilter, Operator:=xlFilterValues
Else
.ListObjects("Tabelle10").Range.AutoFilter Field:=9
End If
End With
End If

If Not Intersect(Target, Range("B2:M4")) Is Nothing Then
With Me
For Each rng In .Range("B2:M4")
If rng "" Then
ReDim Preserve strFilter(lngIndex)
strFilter(lngIndex) = rng.Text
lngIndex = lngIndex + 1
End If
Next

If lngIndex > 0 Then
.ListObjects("Tabelle10").Range.AutoFilter Field:=1, _
Criteria1:=strFilter, Operator:=xlFilterValues
Else
.ListObjects("Tabelle10").Range.AutoFilter Field:=1
End If
End With
End If

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß
Timon

Office: Makro: mehrere Filterkriterien für eine Tabelle per Zellenbezug

Makro: mehrere Filterkriterien für eine Tabelle per Zellenbezug

Makro: mehrere Filterkriterien für eine Tabelle per Zellenbezug

Makro: mehrere Filterkriterien für eine Tabelle per Zellenbezug - Similar Threads - Makro Filterkriterien Tabelle

Name der Datei durch Excel geändert

Ein Makro für mehrere Register

Makro öffnet unerwartete Datei

Leerzeilen entfernen

Makro Schaltflaechen vervielfaeltigen sich....

Seit Win 11 Zugriffsprobleme bei Excel über Makros

VBA-Makro zur Zellenformatierung Syntax probleme