text in zeile

Hallo
Ich habe folgendes Problem.
Ich möchte eine Exceltabelle bearbeiten die folgenden Aufbau hat.
Spalte A: Name
Spalte B: Vorname
Spalte C: Geburtsdatum
Spalte D: DatumVerkauf
Spalte E: Position
das Problem besteht darin,dass die Spalte E einText mit mehreren Positionsnummern ist:
z.B.: 1234,1245,4231,4321d
Jetzt sollte dieser Text in die einzelnen Positionsnummern getrennt werden. jedoch nicht in eine neue Spalte sondern in eine neue Zeile. Dabei soll der entsprechende Name,Vorname.... auch in die neuen Zeilen kopiert werden. Damit ich die Tabelle weiterverarbeiten kann sollte die Spalte E als Zahl definiert sein.
da es auch Ziffern mit einem Buchstabenanhang gibt (z.B.4321d) müssten diese Buchstaben zunächst entfernt werden.
Ich denke dass das in vba möglich ist. leier reichen meine Kenntnisse dfür nicht aus.
für Hilfe bedanke ich mich schon mal hier
migo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo,
wenn ich Dich richtig verstanden habe, müsste es so funktionieren.

Sub Daten_Aufteilen()
Dim ArrayData(), ArrayPos, ArraySplit_Pos
Dim MaxRow As Long
Dim nC As Long, nCC As Long
Dim Regex As Object, strText$

'Tabelle anpassen 
With Tabelle1
    'letzte Zeile bestimmen 
    MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    'letzte Zeile ist Überschrift? Abbrechen! 
    If MaxRow < 2 Then Exit Sub
    'Daten Spalte A bis D in einem Array speichern 
    ArrayData = .Range("A2", .Cells(MaxRow, 4)).Value2
    'Positionen in einem Array speichern 
    ArrayPos = .Range("E2", .Cells(MaxRow, 5))
    'Regexp zum entfernen von Text initialisieren 
    Set Regex = CreateObject("Vbscript.Regexp")
    
    With Regex
       .IgnoreCase = True
       .MultiLine = True
       .Pattern = "[a-z äüöß]+"
       .Global = True
    End With
    
    MaxRow = 2 'erste Einfügezeile 
    
    For nC = 1 To Ubound(ArrayData)
        ArrayPos(nC, 1) = Regex.Replace(ArrayPos(nC, 1), "") 'Text entfernen 
        ArraySplit_Pos = Split(ArrayPos(nC, 1), ",") 'Text Splitten 
        
        'Daten von Spalte A bis D schreiben 
        For nCC = 1 To 4
            .Cells(MaxRow, nCC).Resize(Ubound(ArraySplit_Pos) + 1, 1) = ArrayData(nC, nCC)
        Next nCC
        'Positionen schreiben in Spalte E 
        .Cells(MaxRow, 5).Resize(Ubound(ArraySplit_Pos) + 1, 1) = Application.Transpose(ArraySplit_Pos)
        'nächste Zeile bestimmen 
        MaxRow = MaxRow + Ubound(ArraySplit_Pos) + 1
    Next nC
    
End With

End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

text in zeile

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

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread