Feldertrennung
#11
Noch ein Versuch.

Code:
Sub splitten()
    Dim LR As Integer, Arr1, Arr2, Arr3, i As Integer
   
    LR = Cells(Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
    Arr1 = Application.Transpose(Cells(2, 1).Resize(LR - 1, 1))
   
    For i = LBound(Arr1) To UBound(Arr1)
        Arr2 = Split(Arr1(i), "ab ")
        If UBound(Arr2) > 0 Then
            Arr3 = Split(Arr2(1), " - ")
            Cells(i + 1, 2) = Arr2(0)
            Cells(i + 1, 3) = Arr3(0)
            If UBound(Arr3) > 0 Then Cells(i + 1, 4) = Arr3(1)
        End If

    Next
End Sub
[-] Folgende(r) 1 Nutzer sagt Danke an UweD für diesen Beitrag:
  • sebi007
Top
#12
(08.12.2020, 13:53)UweD schrieb: Noch ein Versuch.

Code:
Sub splitten()
    Dim LR As Integer, Arr1, Arr2, Arr3, i As Integer
  
    LR = Cells(Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
    Arr1 = Application.Transpose(Cells(2, 1).Resize(LR - 1, 1))
  
    For i = LBound(Arr1) To UBound(Arr1)
        Arr2 = Split(Arr1(i), "ab ")
        If UBound(Arr2) > 0 Then
            Arr3 = Split(Arr2(1), " - ")
            Cells(i + 1, 2) = Arr2(0)
            Cells(i + 1, 3) = Arr3(0)
            If UBound(Arr3) > 0 Then Cells(i + 1, 4) = Arr3(1)
        End If

    Next
End Sub

Haut hin. Ich danke Dir recht herzlich, super!
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste