PDA

Vollständige Version anzeigen : Makro: mehrere Filterkriterien für eine Tabelle per Zellenbezug


Timonbarden
08.09.2011, 15:34
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.

Sub Filtern()
'
' Filtern Makro
'
'
ActiveSheet.ListObjects("Tabelle10").Range.AutoFilter Field:=8,
Criteria1:= _ Range("A4").Text, Operator:=xlFilterValues
End Sub

josef e
08.09.2011, 22:38
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo Timo,

anbei ein Beispiel.


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

Timonbarden
09.09.2011, 08:48
Funktioniert super! Danke :)

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.

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


Gruß
Timon