habe in einer Spalte Text stehen der immer mit einem fettgedruckten Textteil anfängt. Ich möchte alles was nach dem fettgedrucktem steht (also nicht fett ist) in Spalte 2 verschieben.
Danke,
Uwe
Option Explicit
Sub Trennen()
Dim Zelle As Range
Dim i As Integer
On Error GoTo Fehler
Application.ScreenUpdating = False
For Each Zelle In Range(Cells(1, 1), Cells(Range("A1").End(xlDown).Row, 1))
i = 0
Do
i = i + 1
Loop Until Not Zelle.Characters(i, 1).Font.Bold
Zelle.Offset(0, 1) = Mid(Zelle, i)
Zelle = Left(Zelle, i - 1)
Next
Fehler:
Application.ScreenUpdating = True
Set Zelle = Nothing
End Sub
Option Explicit
Sub Trennen()
Dim Zelle As Range
Dim i As Integer, p As Integer
On Error GoTo Fehler
Application.ScreenUpdating = False
For Each Zelle In Range(Cells(1, 1), Cells(Range("A1").End(xlDown).Row, 1))
i = 0
p = Len(Zelle)
Do
i = i + 1
Loop Until Not Zelle.Characters(i, 1).Font.Bold Or i > p
Zelle.Offset(0, 1) = Mid(Zelle, i)
Zelle = Left(Zelle, i - 1)
Next
Fehler:
Application.ScreenUpdating = True
Set Zelle = Nothing
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen