Sub Datum()
Dim c As Range
Dim a As Range
Dim b As Range
Dim d As Range
Dim e As Range
Dim f As Range
Dim anzMonat As Long
Dim i As Long
i = 0
With Worksheets("Datum").Columns(13)
Set c = .Find(what:="Datum", lookat:=xlPart)
Set f = .Find(what:="Date", lookat:=xlPart)
Set a = .Find(what:="*mo*", lookat:=xlPart)
Set b = .Find(what:="*w*", lookat:=xlPart)
Set d = .Find(what:="*ta*", lookat:=xlPart)
Set e = .Find(what:="*da*", lookat:=xlPart)
If Not IsEmpty(c) Or Not IsEmpty(f) Then
Do
If Not c Is Nothing Then
Do
If Len(c) < 3 Then
c.Value = Date
Else
For i = 3 To Len(c)
If IsNumeric(Mid(c, i, 1)) Then
anzMonat = Mid(c, i, 1)
If Not a Is Nothing Then
c.Value = DateAdd("m", CDbl(anzMonat), Date)
Else
If Not b Is Nothing Then
c.Value = DateAdd("ww", CDbl(anzMonat), Date)
Else
If Not c Is noting Then
c.Value = DateAdd("d", CDbl(anzMonat), Date)
Else
If Not d Is Nothing Then
c.Value = DateAdd("d", CDbl(anzMonat), Date)
Else
c.Value = DateAdd("d", CDbl(anzMonat), Date)
End If
End If
End If
End If
Exit For
End If
Next
End If
Set c = .FindNext(c)
Loop Until c Is Nothing
End If
If Not f Is Nothing Then
Do
If Len(f) < 3 Then
f.Value = Date
Else
For i = 3 To Len(f)
If IsNumeric(Mid(f, i, 1)) Then
anzMonat = Mid(f, i, 1)
If Not a Is Nothing Then
f.Value = DateAdd("m", CDbl(anzMonat), Date)
Else
If Not b Is Nothing Then
f.Value = DateAdd("ww", CDbl(anzMonat), Date)
Else
If Not c Is noting Then
f.Value = DateAdd("d", CDbl(anzMonat), Date)
Else
If Not d Is Nothing Then
f.Value = DateAdd("d", CDbl(anzMonat), Date)
Else
f.Value = DateAdd("d", CDbl(anzMonat), Date)
End If
End If
End If
End If
Exit For
End If
Next
End If
Set f = .FindNext(f)
Loop Until f Is Nothing
End If
Loop Until c Is Nothing Or f Is Nothing
End If
End With
End Sub