Text aufspalten in verschiedene Spalten

Hallo zusammen,
ich hab das Problem, einer Zeichenkette ("C:\programme\aaa\bbb\ccc\dateiname.csv") in einer Spalte.
Jetzt sollen "aaa", "bbb", "ccc" und der Dateiname (ohne Endung) jeweils in eine eigene Spalte kommen. Zeilen, die nicht mit csv enden, sollen gelöscht werden.
Ich hab jetzt angefangen, mit dem Makrorekorder vorzuturnen. Aber es gibt leider viele verschiedene "aaa's" "bbb's" und "ccc's". Also wird der Code entsprechend lang und sonderlich performant ist das ganze auch nicht.
Leider kenn ich mich syntaktisch noch nicht so sehr aus in VBA, als das ich alleine jetzt mit verschiedenen For, if und while Schleifen zum Ziel käme. Mit der texttocolumns-Methode kam ich nicht zurecht. Hat jemand eine Idee wie ich das ganze performanter und kürzer entwickeln kann?
Danke schon mal !
Gruß

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
markiere die betreffenden Zellen der Spalte und lasse dieses Makro rüberlaufen:

Option Explicit
Sub TeileAuf()
Dim a As Long '1. Zeile der Markierung
Dim b As Long ' letzte Zeile der Markierung
Dim c As Integer 'Spalte der Markierung
Dim r As Integer 'aktuelle Zeile
Dim t As String
Dim e() As String
Const z = "\" 'Trennzeichen
Const x = 2 'nur Text nach dem x-ten Trennezeichen ausgeben
If Selection.Columns.Count <> 1 Then MsgBox "Nur eine Spalte wählen!": Exit Sub
a = Selection.Row
b = a + Selection.Rows.Count - 1
c = Selection.Column
For r = b To a Step -1 'von unten nach oben
    'Text holen
    t = Cells(r, c)
    If Not t Like "*.csv" Then
        'löschen, wenn Endung nicht *.csv
        Cells(r, c).EntireRow.Delete
    Else
        'Text vor dem x-ten Trennzeichen löschen
        t = Replace(t, z, Chr(0), 1, x)
        t = Mid(t, InStrRev(t, Chr(0)) + 1)
        'Endung löschen und Text aufsplitten
        e = Split(Left(t, Len(t) - Len(".csv")), z)
        'eintragen
        Range(Cells(r, c + 1), Cells(r, c + 1 + UBound(e))) = e
    End If
Next r
End Sub

Gruß- Micha
PS: Rückmeldung wäre nett.

Sub SplitAndJoin() Dim sText As String, vX As Variant, i As Long sText = [B5] vX = Split(sText, "\") For i = 0 To UBound(vX) vX(i) = i + 1 & ". " & vX(i) vX (i) ' spaltenweise schreiben Next i sText = Join(vX, ",") MsgBox sText End Sub

Sub SplitAndJoin() Dim sText As String, vX As Variant, i As Long, j As Long Zeile = ActiveSheet.Range("B65535").End(xlUp).Offset(1, 0).Row 'die Zeile mit der letzten beschriebenen Zelle For j = 1 To Zeile sText = Range("B" & j) vX = Split(sText, "\") For i = 0 To UBound(vX) vX(i) = i + 1 & ". " & vX(i) 'vX(i) spaltenweise schreiben Range(Cells(j & i), Cells(j & i & UBound(vX))) = vX(i) Next i Next j End Sub

Beliebteste Forumthreads (12 Monate)

Text aufspalten in verschiedene Spalten

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Text aufspalten in verschiedene Spalten

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread