Feldertrennung

[sebi007]

Servus zusammen,

ich stehe VBA-technisch leider komplett auf dem Schlauch.
Ich habe bei ca. 15.000 Zeilen in jeder Zelle eine Begründung mit Datum. Diese baut sich folgendermaßen auf (s. Dateianhang):

Begründung + ab TT.MM.JJJJ + (- TT.MM.JJJJ)
Der erste Teil ist immer so vorhanden, der Teil in Klammern nicht.

Ich würde nun gerne für den weiteren Gebrauch ein Makro erstellen, das die Informationen auf drei Felder aufteilt (s. Dateianhang):

Begründung,von,bis

D.h. den Teil bis zum "ab" in das Feld "Begründung". Das erste Datum in das Feld "von" und wenn vorhanden das zweite Datum in das Feld "bis".
Ich glaube, ich würde es durch Formeln mit einem workaround hinbekommen, aber ich bin makrotechnisch blank.

Ich hoffe, ihr könnt mir helfen und verbleibe

mit den besten Grüßen!

[steve1da]

Hola,

und warum ein Makro wenn es mit 3 kleinen Formeln erledigt werden kann?

Gruß,
steve1da

[LCohen]

B1[:D1]: =WECHSELN(GLÄTTEN(TEIL(WECHSELN(WECHSELN(WECHSELN(A1;" + ab";);" + (-";);" ";WIEDERHOLEN(" ";99));SPALTE(A1)*99-98;98));")";)

In C1 und D1 kannst Du ein -- voranstellen, damit es zu Zahl wird.

[sebi007]

Hola,

und warum ein Makro wenn es mit 3 kleinen Formeln erledigt werden kann?

Gruß,
steve1da

Die Daten werden im täglichen Gebrauch immer wieder auf die ursprüngliche Weise angeliefert und ich habe das Gefühl, dass "Knöpfchen-Drücken" für die Kollegen praktikabler sein wird.

[UweD]

Hi

versuch es mal so..

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 ")
        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)

    Next
End Sub

LG UweD

[sebi007]

Hi

versuch es mal so..

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 ")
        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)

    Next
End Sub

LG UweD

Hi Uwe,

vielen Dank! Ich habe das jetzt auf meine Tabelle umgeschrieben und es tut genau das, was es soll.
Es kommt gelegentlich vor, dass Zellen nicht befüllt sind. Wie kann ich denn einbauen, dass es in diesem Fall einfach zur nächsten Zelle springt.

Nochmal herzlichen Dank!

[UweD]

Also mit den Beispielen von dir klappte es.

Dann zeig mal Daten, wo es NICHT funktioniert hat.


LG

[sebi007]

Also mit den Beispielen von dir klappte es.

Dann zeig mal Daten, wo es NICHT funktioniert hat.


LG

Wenn eine Zelle nicht befüllt ist, oder die darin befindlichen Daten nicht dem Usus entsprechen, bekomme ich einen Error "Index außerhalb des gültigen Bereichs". Ich habe versucht, den Code selbst umzuschreiben, sodass entsprechende Zelle übersprungen wird, komme aber nicht drauf...

[UweD]

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)
        End If
        If UBound(Arr3) > 0 Then Cells(i + 1, 4) = Arr3(1)

    Next
End Sub

so???

[sebi007]

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)
        End If
        If UBound(Arr3) > 0 Then Cells(i + 1, 4) = Arr3(1)

    Next
End Sub

so???

Lieben Dank für Deine Mühe. Wenn die erste Zeile leer ist, wirft er mir in der letzten Zeile (If Ubound(Arr3) > 0 (...)) aus, dass die Typen unverträglich seien.