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