Sub Test()
Dim arrFnd() As Variant, arrRep() As Variant
Dim arrChk() As Variant
Dim x As Long, z As Long
Dim Chk As Range
'Referenzen
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
'In Spalte rechts von Spalte "A"
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
'Prüfung
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
|