Option
Explicit
Public
Sub
Ersetzen()
Dim
i
As
Long
, raErsetzen
As
Range
With
Worksheets(
"Tabelle1"
)
For
i = 2
To
.Cells(.Rows.Count,
"A"
).
End
(xlUp).Row
Select
Case
.Cells(i,
"A"
)
Case
"Auto"
,
"Baum"
,
"Fahrrad"
If
raErsetzen
Is
Nothing
Then
Set
raErsetzen = .Cells(i,
"B"
)
Else
Set
raErsetzen = Union(raErsetzen, .Cells(i,
"B"
))
End
If
Case
Else
End
Select
Next
i
If
Not
raErsetzen
Is
Nothing
Then
raErsetzen =
"A"
End
If
End
With
Set
raErsetzen =
Nothing
End
Sub