AW: Daten aus Zelle ausschneiden und in Zeile einfügen
03.05.2024 12:28:45
UweD
Hallo nochmal
Ich hab den nicht "vorhandenen Fehler" mal abgefangen (paradox :-)
Sub Trennen()
Dim Arr, Trenn1 As String, Trenn2 As String, i As Integer, Tmp As String, Pos As Integer, Ausname As String
Trenn1 = " km "
Trenn2 = "Fehler "
With Sheets("Tabelle1")
Arr = Split(.Cells(1, 1), Trenn1) 'Text wird gesplittet bei km
'Nur für den ersten Satz
.Cells(1, 1) = Trim(Arr(0) & Trenn1)
For i = 1 To UBound(Arr) 'für alle Datensätze
If InStr(Arr(i), Trenn2) Then
'Wenn FEHLER im Datensatz vorhanden, dann dort splitten
.Cells(i, 2) = Split(Arr(i), Trenn2)(0) 'erster Teil in B
Tmp = Split(Arr(i), Trenn2)(1) 'restlicher Teil
Ausname = Trenn2
Else
'Kein FEHLER im Datensatz
Tmp = Arr(i) 'nicht trennen in B und C
Ausname = ""
End If
Pos = InStrRev(Tmp, " ") 'Position des Letzten Leerzeiches von hinten
.Cells(i, 3) = Ausname & Left(Tmp, Pos - 1) 'Rest ohne die letzten KM in Spalte C
'wenn es Nicht der letzte Datensatz ist, dann KM ab dem letzten Leerzeichen in die nächste Zeile setzen
If i UBound(Arr) Then .Cells(i + 1, 1) = Trim(Mid(Tmp, Pos) & Trenn1)
Next
End With
End Sub
LG UweD