Wörter Zusammenfügen

Alb Steindrucker Gertrudstrasse 44
M e i e r Anna Part Nürenbergstrasse 25
Arnold Kaufmann; Langmauerstrasse 7
Aug Schlosser Hönggerstrasse 2
M a a g Barba Part Schulhausstrasse 30
gerne würde ich ein makro programieren welches mit jedes der wörter in eine eigen Spalte setzt.
Dies konnte ich auch machen indem ich ein Makro kreierte welches mir die " " durch "," ersetzt. und den Text dann anhand der "," in neue Spalten aufteilt.
Mein Problem ist nun, dass ich bei Wörtern wie M e i e r dies erhalte M,e,i,e,r, und somit jeden einzelnen Buchstaben in eine neue Spalte versetze.
jj.Value = Replace(jj.Value, " ", ",")
Next
Dim Fullname As Variant
For Each jj In Worksheets("Tabelle1").Range("A1:A250").Cells
Fullname = Split(jj.Value, ",")
For ii = 0 To UBound(Fullname)
Cells(jj.Row, ii + 1) = Fullname(ii)
Next ii
Next
gibt es eine möglichkeit, dass ich das jj.Value = Replace(jj.Value, " ", ",") so definiere, das das "," nur eingesetzt wird wenn es mehr als 1 Buchstaben ist?
Für eure Hilfe wäre ich sehr Dankbar

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
nein, das kann man für Replace so nicht defineren.
Du musst das hier selber programmieren.
der folgende Code trennt die Texte zunächst am Leerzeichen auf und setzt sie dann neu zusammen.
Dabei wird geprüft, ob es sich um einen Einzelbuchstaben oder um ein ganzes Wort oder eine Zahl handelt.
bei ganzen Wörtern oder Zahl wird das Komma als Trennzeichen eingesetzt, bei Einzelbuchstaben das Leerzeichen.
die Texte werden zuerst so wieder in die Spalte zurückgeschrieben und dann mit TEXT IN SPALTEN aufgeteilt.
das geht schneller, als jedes Wort einzeln in die Zellen zu schreiben:

Sub umwandeln()
Dim arr
Dim TT() As String
Dim i As Long, z As Long
With Range("A1:A250")
arr = .Value
For z = 1 To UBound(arr, 1)
If arr(z, 1)  "" Then
TT = Split(arr(z, 1), " ")
arr(z, 1) = TT(0)
For i = 1 To UBound(TT)
If Len(TT(i)) > 1 Or Len(TT(i - 1)) > 1 Or IsNumeric(TT(i)) Then
arr(z, 1) = arr(z, 1) & "," & TT(i)
Else
arr(z, 1) = arr(z, 1) & " " & TT(i)
End If
Next
End If
Next
.Value = arr
.TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False
End With
End Sub

Gruß Daniel

	A	B	C	D	E	F	G	H
1	Alb Steindrucker Gertrudstrasse 44	Alb	Steindrucker	Gertrudstrasse	44
2	M e i e r Anna Part Nürenbergstrasse 25	Meier	Anna	Part	Nürenbergstrasse	25
3	Arnold Kaufmann; Langmauerstrasse 7	Arnold	Kaufmann	Langmauerstrasse	7
4	Aug Schlosser Hönggerstrasse 2	Aug	Schlosser	Hönggerstrasse	2
5	M a a g Barba Part Schulhausstrasse 30	Maag	Barba	Part	Schulhausstrasse	30
6	ZellFmln in D1:H1[;D2:H5]: {=VSplit(MaskOn(VJoin(WENN(IDENTISCH(GROSS(LINKS(VSplit(A1)));LINKS(VSplit(A1)));" ";"")&VSplit(A1);"");"anu")&" ";;1)}

Alb Steindrucker Gertrudstrasse 44

Alb

Steindrucker

Gertrudstrasse

M e i e r Anna Part Nürenbergstrasse 25

Meier

Anna

Part

Nürenbergstrasse

Arnold Kaufmann; Langmauerstrasse 7

Arnold

Kaufmann

Langmauerstrasse

Aug Schlosser Hönggerstrasse 2

Aug

Schlosser

Hönggerstrasse

M a a g Barba Part Schulhausstrasse 30

Maag

Barba

Part

Schulhausstrasse

ZellFmln in D1:H1[;D2:H5]: {=VSplit(MaskOn(VJoin(WENN(IDENTISCH(GROSS(LINKS(VSplit(A1)));LINKS(VSplit(A1)));" ";"")&VSplit(A1);"");"anu")&" ";;1)}

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread