Schleife bleibt hängen?

Sub WortEinsFinden()
Application.DisplayAlerts = False
Application.EnableEvents = False
Dim Zeile  As Long
Dim ZeileMax As Long
With tbl_DatenstammKomplett
ZeileMax = .UsedRange.Rows.Count
For Zeile = 2 To ZeileMax
.Range("D2").FormulaR1C1 = "=WortFinden(RC[-1],1)"
Next Zeile  ' Hier bleibt der Code hängen. Warum?
End With
endmacro:
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Function WortFinden(Source As String, Position As Integer)
Dim arr()  As String
Dim xCount As Integer
arr = VBA.Split(Source, " ")
xCount = UBound(arr)
If xCount  xCount Or Position