Option
Explicit
Sub
Ausblenden()
Dim
strSuche
As
String
, loZeile
As
Long
, i
As
Long
, raFund
As
Range
Dim
raEin
As
Range, strAdresse
As
String
loZeile = Range(
"C5"
).CurrentRegion.SpecialCells(xlCellTypeLastCell).Row
If
Range(
"I3"
) <>
""
Then
strSuche = Range(
"I3"
)
For
i = 3
To
6
With
Columns(i)
Set
raFund = .Find(what:=
"*"
& strSuche &
"*"
, LookIn:=xlValues, lookat:=xlPart)
If
Not
raFund
Is
Nothing
Then
strAdresse = raFund.Address
Do
If
raEin
Is
Nothing
Then
Set
raEin = raFund
Else
Set
raEin = Union(raEin, raFund)
End
If
Set
raFund = .FindNext(raFund)
Loop
While
Not
raFund
Is
Nothing
And
raFund.Address <> strAdresse
End
If
End
With
Next
i
If
Not
raEin
Is
Nothing
Then
Range(
"C6:C"
& loZeile).EntireRow.Hidden =
True
raEin.EntireRow.Hidden =
False
End
If
Else
Cells.EntireRow.Hidden =
False
End
If
Set
raFund =
Nothing
:
Set
raEin =
Nothing
End
Sub