Sub namen_splitten()
Dim text As String
Dim ergebnis(6)
Dim zeile As Long
Dim anzahl As Long
anzahl = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
For zeile = 1 To anzahl
For i = 1 To 6
ergebnis(i) = ""
Next i
text = Trim(Cells(zeile, 1))
text = Replace(text, ".", ". ")
text = Replace(text, Chr(160), " ")
text = Trim(Replace(text, " ", " "))
If Left(text, 4) = "Frau" Then
ergebnis(1) = "Frau"
text = Trim(Right(text, Len(text) - 4))
End If
If Left(text, 4) = "Herr" Then
ergebnis(1) = "Herr"
text = Trim(Right(text, Len(text) - 4))
End If
If Left(text, 3) = "Dr." Then
ergebnis(2) = "Dr."
ergebnis(3) = "Dr."
text = Trim(Right(text, Len(text) - 3))
End If
If Left(text, 5) = "Prof." Then
ergebnis(2) = "Prof."
ergebnis(3) = "Prof."
text = Trim(Right(text, Len(text) - 5))
End If
If Left(text, 3) = "Dr." Then text = Trim(Right(text, Len(text) - 3))
If Left(text, 5) = "Prof." Then text = Trim(Right(text, Len(text) - 5))
If Left(text, 1) = "-" Then
ergebnis(2) = ergebnis(2) & " " & Split(text, " ")(0)
text = Trim(Replace(text, Split(text, " ")(0), "", , 1))
End If
If Right(text, 1) = "-" Or Right(text, 1) = ")" Then
If Right(text, 1) = "-" Then
ergebnis(6) = Split(text, "-")(UBound(Split(text, "-")))
text = Trim(Replace(text, "-" & ergebnis(6) & "-", ""))
End If
If Right(text, 1) = ")" Then
ergebnis(6) = Replace(Split(text, "(")(UBound(Split(text, "("))), ")", "")
text = Trim(Replace(text, "(" & ergebnis(6) & ")", ""))
End If
End If
ergebnis(4) = Split(text, " ")(0)
If UBound(Split(text, " ")) > 0 Then ergebnis(5) = Split(text, " ")(1)
For i = 1 To 6
ActiveSheet.Cells(zeile, 5 + i) = ergebnis(i)
Next
Next zeile
End Sub