Option
Explicit
Option
Compare Text
Sub
Ersetze2()
Dim
iZeile
As
Long
, iSpalte
As
Long
, iCheck
As
Integer
Dim
sSuch1
As
String
, sSuch2
As
String
, sErsetz
As
String
Dim
rngBereich
As
Excel.Range
Dim
rngZelle
As
Excel.Range
sSuch1 =
"apfel"
sSuch2 =
"Birne"
sErsetz =
"Apfelkuchen"
Set
rngZelle = Range(
"A1"
)
Do
While
rngZelle.Value <>
""
Set
rngBereich = rngZelle.MergeArea.Resize(Cells(Rows.Count, rngZelle.Column).
End
(xlUp).Row - rngZelle.Row + 1)
For
iZeile = 2
To
rngBereich.Rows.Count
iCheck = 0
For
iSpalte = 1
To
rngBereich.Columns.Count
If
rngBereich(iZeile, iSpalte).Value
Like
(
"*"
& sSuch1 &
"*"
)
Then
iCheck = (iCheck
Or
1)
If
rngBereich(iZeile, iSpalte).Value
Like
(
"*"
& sSuch2 &
"*"
)
Then
iCheck = (iCheck
Or
2)
If
iCheck = 3
Then
Exit
For
Next
If
iCheck = 3
Then
rngBereich.Rows(iZeile).Replace _
What:=sSuch1, _
Replacement:=sErsetz, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=
False
End
If
Next
Set
rngZelle = rngZelle.Offset(0, 1)
Loop
End
Sub