Moin! Also so einfach ist das nicht. Excel kann zB nicht erkennen, ob ein Name Vor- oder Nachname ist. Zudem kann man ncht alle Möglichkeiten abfangen, da unbekannt. Hier mal eine Variante die aber nur auf deine Beispiele zugeschnitten ist. Sollte was anderes vorkommen, wird es evtl. nicht klappen. Einfach mal probieren. VG
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
|