In einem markierten Bereich befinden sich in jeweils einer Zelle Vornamen und Nachnamen, die durch Leerstellen getrennt sind. Wie kann ich Vornamen und Nachnamen in die Nachbarzellen einlesen lassen?
Hier wird an den Leerzeichen getrennt, ggf. müssen noch weitere Schreibweisen beachtet werden.
Schleife über die Zellen
Variante 1:
Sub Namen_trennen()
Dim rngZelle As Range
Dim intS As Integer
Dim strV As String
Dim arrTemp
'Bereich mu� markiert sein, für jede Zelle in der Markierung:
For Each Zelle In Selection
With Zelle
If .Value <> "" Then
arrTemp = Split(.Value, " ")
Select Case UBound(arrTemp)
Case 0: Cells(.Row, .Column + 1) = .Value
Case Else
strV = ""
For intS = 0 To UBound(arrTemp) - 1
strV = strV & IIf(strV <> "", " ", "") & arrTemp(intS)
Next
Cells(.Row, .Column + 1) = strV
Cells(.Row, .Column + 2) = arrTemp(UBound(arrTemp))
End Select
End If
End With
Next
End Sub
Variante 2:
Sub Namen_trennen1()
Dim intA As Integer, intB As Integer, intI As Integer
Dim Zelle As Object
'Bereich muÃ? markiert sein,
'für jede Zelle in der Markierung:
For Each Zelle In Selection
With Zelle
If .Value <> "" Then
'Suche nach der ersten Leerstelle
intA = InStr(.Value, " ")
'Schleife, falls mehrere durch leer getrennte Vornamen
'vorhanden sind, z. B. Ute Elke Meier
For intI = 0 To Len(.Value)
intB = InStr(Right(.Value, Len(.Value) - intA), " ")
intA = InStr(Right(.Value, Len(.Value) - intA), " ") + intA
Next
'Aufteilen auf die 1. Zelle rechts und die 2. Zelle rechts
'Vorname
Cells(.Row, .Column + 1).Value = Left(.Value, intA - 1)
'Name
Cells(.Row, .Column + 2).Value = Right(.Value, Len(.Value) - intA)
End If
End With
Next
End Sub
Text in Spalten
Variante 3:
Sub Namen_trennen2()
Dim lngZeile As Long, lngSpalte As Long, strZiel As String
lngZeile = ActiveCell.Row: lngSpalte = ActiveCell.Column
strZiel = Cells(lngZeile, lngSpalte + 2).Address
Selection.TextToColumns Destination:=Range(strZiel), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1))
End Sub
Es ist mit dieser Methode auch möglich, mehr als 2 Wörter, die mit Leerzeichen getrennt sind, in die Nachbarzellen zu übertragen. Sollten in nebenstehenden Zellen Daten stehen, muss man vor der Ausführung des Befehls darauf achten, entsprechend viele Spalten einzufügen.
Dynamische Arrayformel mit Matrixfunktion
Je nach Situation kann auch eine Arrayformel in Betracht gezogen werden:
Function NamenTrennen(ByVal strName As String, Optional intAnzahl As Integer = 5)
Dim arrTemp, intS As Integer
ReDim arrNamen(1 To intAnzahl)
NamenTrennen = ""
For intS = 1 To intAnzahl
arrNamen(intS) = ""
Next
If strName <> "" Then
arrTemp = Split(strName, " ")
For intS = 0 To UBound(arrTemp)
If intS < intAnzahl Then arrNamen(intS + 1) = arrTemp(intS)
Next
End If
NamenTrennen = arrNamen
End Function
In die Zelle kommt dazu diese überlaufende Formel:
=NamenTrennen(A1)
Da die Anzahl der Namensteile variieren kann, ein Array aber (in diesem Fall) immer gleich breit ist, ist eine Breite von fünf Zellen voreingetragen. Der Array wird dabei von links gefüllt, so dass die einzelnen Teile in der linken Zelle beginnen. Mit einem zweiten Parameter in der Funktion kann diese Breite geändert werden, zum Beispiel auf vier Zellen Breite:
=NamenTrennen(A1;4)
Besteht der Name dann aus mehr Teilen, werden die restlichen rechten Teile nicht angezeigt.
Suchergebnisse (2 Treffer, 1 Begriff) 
Kategorien: 
