Sub
Test()
Dim
arrFnd()
As
Variant
, arrRep()
As
Variant
Dim
arrChk()
As
Variant
Dim
x
As
Long
, z
As
Long
Dim
Chk
As
Range
arrFnd = Array(
"ABC"
,
"FRG"
,
"TST"
,
"WOS"
,
"WAS"
,
"WER"
)
arrRep = Array(
"ABC Text"
,
"FRG Text"
,
"TST Text"
,
"WOS Text"
,
"WAS Text"
,
"WER Text"
)
Application.ScreenUpdating =
False
With
Range(Cells(1, 1), Cells(Rows.Count, 1).
End
(xlUp)).Offset(, 1)
.FormulaR1C1 =
"=LEFT(RC[-1],3)"
For
x = 1
To
.Cells.Count
For
z = LBound(arrFnd, 1)
To
UBound(arrFnd, 1)
If
arrFnd(z) = .Cells(x).Value
Then
.Cells(x).Formula = arrRep(z)
End
If
Next
z
Next
x
On
Error
Resume
Next
Set
Chk = .SpecialCells(xlCellTypeFormulas)
MsgBox Format(Chk.Cells.Count,
"0"
) &
" Fehler gefunden"
On
Error
GoTo
0
End
With
Application.ScreenUpdating =
True
End
Sub