Sub
Tabellenfilter()
Dim
lngArea
As
Long
Dim
c
As
Excel.Range
Dim
rng
As
Excel.Range
Dim
rngIsect
As
Excel.Range
Dim
z
As
Long
Dim
abc
As
Long
Dim
Inhalt
As
Variant
Dim
Txt
As
String
Txt = InputBox(
"Eingabe:"
)
If
Txt =
""
Then
Exit
Sub
Set
rng = Range(
"A1"
).CurrentRegion
rng.AutoFilter Field:=1, Criteria1:=Txt
Set
rngIsect = Intersect(rng.Columns(1), rng.Offset(1, 0), rng.SpecialCells(xlCellTypeVisible))
For
lngArea = 1
To
rngIsect.Areas.Count
For
Each
c
In
rngIsect.Areas(lngArea)
Inhalt = Inhalt &
"|"
& Join(Split(c.Offset(0, 2), Chr(32)), Chr(124))
Next
c
Next
If
Left(Inhalt, 1) = Chr(124)
Then
Inhalt = Txt & Inhalt
End
If
Inhalt = Split(Inhalt, Chr(124))
rng.AutoFilter Field:=1, Criteria1:=Inhalt, Operator:=xlFilterValues
End
Sub