Text aufgleidern anch Textimport

Hallo,
nun mal etwas für die Profis unter euch.
Ich bekomme nach einem Textimport folgende Datensätze ins Excel:
Achim Altschaeffl/2/598/BBK/DE
Achim Ehresmann/DV3/DV/504/BBK/DE
Achim Held/IT/HO/498/BBK/DE
Achim Klier/RZ/698/BBK/DE
Adelheid Rothfuss/2/598/BBK/DE
Adelheid Woldorf/380/498/BBK/DE
Adrian Blackert/6/598/BBK/DE
Ich möchte nun das in der Spalte 1 der Vorname steht
Spalte 2 der Nachname
dann soll jedoch von rechts sortiert werden und zwar in der ganz rechten Spalte immer das DE
links daneben das BBK
dann immer die Zahl z.B. 598, 498, 504 usw
und links davon die anderen Aufteilung bis mann zu der Spalte Nachname kommt
Achim Altschaeffl 2 598 BBK DE
Achim Ehresmann DV3 DV 504 BBK DE
Achim Held IT HO 498 BBK DE
Achim Klier RZ 698 BBK DE
Adelheid Rothfuss 2 598 BBK DE
Adelheid Woldorf 380 498 BBK DE
Adrian Blackert 6 598 BBK DE
zum Beispiel so.
Userbild

Es wäre fantastisch wenn ihr Profis mir da helfen könnt. Mir fehlt absolut die Idee wie ich das anstellen soll.
ggf. bis gleich
liebe Grüße
Benny

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Aufteilen() Dim lngLastRow As Long, lngI As Long, lngN As Long, lngDiff As Long Dim strHelp As String Dim varHelp lngLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row For lngI = 1 To lngLastRow strHelp = ActiveSheet.Cells(lngI, 1) varHelp = Split(Replace(strHelp, " ", "/"), "/") ActiveSheet.Cells(lngI, 1) = varHelp(0) ActiveSheet.Cells(lngI, 2) = varHelp(1) lngDiff = 6 - UBound(varHelp) For lngN = UBound(varHelp) To 2 Step -1 ActiveSheet.Cells(lngI, lngN + lngDiff + 1) = varHelp(lngN) Next lngN Next lngI End Sub

Sub Aufteilen() Dim lngI As Long, lngN As Long, lngDiff As Long, lngMax As Long Dim varHelp lngMax = 0 With ActiveSheet ' maximale Spaltenanzahl ermitteln For lngI = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row varHelp = Split(Replace(.Cells(lngI, 1), " ", "/"), "/") If lngMax < UBound(varHelp) Then lngMax = UBound(varHelp) End If Next lngI ' Aufteilen For lngI = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row varHelp = Split(Replace(.Cells(lngI, 1), " ", "/"), "/") .Cells(lngI, 1) = varHelp(0) .Cells(lngI, 2) = varHelp(1) lngDiff = lngMax - UBound(varHelp) For lngN = UBound(varHelp) To 2 Step -1 .Cells(lngI, lngN + lngDiff + 1) = varHelp(lngN) Next lngN Next lngI End With End Sub

Hallo Benny,
ja ist das denn hier ein Wunschkonzert ?! Die nächste Änderung kostet Geld ;-)

Sub AufteilenNeu()
Dim lngI As Long, lngN As Long, lngDiff As Long, lngMax As Long
Dim varHelp
lngMax = 0
With ActiveSheet
' maximale Spaltenanzahl ermitteln
For lngI = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
varHelp = Split(.Cells(lngI, 1), "/")
If lngMax < UBound(varHelp) Then
lngMax = UBound(varHelp)
End If
Next lngI
lngMax = lngMax + 1
' Aufteilen
For lngI = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
varHelp = Split(.Cells(lngI, 1), "/")
.Cells(lngI, 1) = Left(varHelp(0), InStrRev(varHelp(0), " ") - 1)
.Cells(lngI, 2) = Right(varHelp(0), Len(varHelp(0)) - InStrRev(varHelp(0), " "))
lngDiff = lngMax - UBound(varHelp)
For lngN = UBound(varHelp) To 1 Step -1
.Cells(lngI, lngN + lngDiff + 1) = varHelp(lngN)
Next lngN
Next lngI
End With
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread