Löschen von Zeilen innerhalb einer Zelle

Hallo zusammen,
ich beiße mir nun schon seit einiger Zeit die Zähne aus und wende mich deshalb ans Forum. Beispieldatei liegt hier https://www.herber.de/bbs/user/100798.xlsx
Es geht um einen Datensatz mit Emails. In jeder Zeile finden sich die Daten zu einer Email. In der Spalte F findet sich jeweils der Inhalt der Mails.
Problem: In den jeweiligen Zellen der Spalte F steht nicht nur der Text dieser Mail, sondern auch der Text vorheriger Mails. Die jeweiligen Zeilen innerhalb der Zellen der Spalte F beginnen jeweils mit "! !".
Damit ich den Datensatz auswerten kann muss ich alle Zeilen innerhalb der Zellen der Spalte F die mit "! !" beginnen entfernen.
Meine Idee wäre ein Makro/Formel, dass alle Zelleninhalte zwischen ! ! und dem Zeichen (10) des ASCII_Code (=Zeilenumbruch in Zelle) löscht.
Da die Anzahl der Zeilen je Eintrag variiert, braucht man vermutlich noch ein Abbruchkriterium.
Warum ich es nicht von Hand mache: Der Datensatz enthält mehrere tausend Einträge.
Ich wäre auf alle Fälle dankbar für Eure Hilfe!
Viele Grüße,
Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Daniel,
in den Zelltexten befindet sich auch noch versteckt das Zeichen 13 (Absatzschaltung)
und Text vom Virenscanner ist auch irgendwie überflüssig.
Probiere mal, ob das folgende Makro deine Anforderungen abdeckt.
Gruß
Franz

Sub Zeilen_in_Zellen_entfernen()
Dim wks As Worksheet
Dim Zelle As Range
Set wks = ActiveSheet
Application.ScreenUpdating = False
With wks
With .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp))
For Each Zelle In .Cells
Zelle.Value = fncTextaufbereiten(Zelle.Text)
Next
'Zellbereich neu formatieren
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.ShrinkToFit = True
.MergeCells = False
.EntireRow.AutoFit
End With
End With
Application.ScreenUpdating = True
End Sub
Public Function fncTextaufbereiten(strText As String) As String
'zitierte Zeilen und Virenschutz-Hinweis in Zellen entfernen
Dim strErgebnis As String, intScan As Integer
Dim Pos1 As Long, Pos2 As Long
Dim strScan(1 To 2, 1 To 2) As String
strScan(1, 1) = "! !": strScan(1, 2) = Chr(10)
strScan(2, 1) = "This email has been scanned"
strScan(2, 2) = "anti-virus technology"
strErgebnis = Trim(strText)
If strErgebnis = "" Then Exit Function
'Absatzschaltungen durch Zeilenschaltung ersetzen
strErgebnis = VBA.Replace(strText, Chr(13), Chr(10))
For intScan = 1 To UBound(strScan, 1)
If InStr(1, strText, strScan(intScan, 1)) > 0 Then
Do
Pos1 = InStr(1, strErgebnis, strScan(intScan, 1))
Pos2 = InStr(Pos1, strErgebnis, strScan(intScan, 2))
Pos2 = Pos2 + Len(strScan(intScan, 2)) - 1
strErgebnis = Left(strErgebnis, Pos1 - 1) & Mid(strErgebnis, Pos2 + 1)
Loop Until InStr(1, strErgebnis, strScan(intScan, 1)) = 0
End If
Next
'doppelte Zeilenschaltungen ersetzen durch eine
Do Until InStr(1, strErgebnis, Chr(10) & Chr(10)) = 0
strErgebnis = VBA.Replace(strErgebnis, Chr(10) & Chr(10), Chr(10))
Loop
fncTextaufbereiten = strErgebnis
End Function

Sub Zeilen_in_Zellen_entfernen2() Dim wks As Worksheet Dim Zelle As Range Set wks = ActiveSheet Application.ScreenUpdating = False With wks With .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp)) .Replace What:="! !*" & Chr(10), Replacement:="", lookat:=xlPart .Replace What:="This email has been scanned*anti-virus technology", _ Replacement:="", lookat:=xlPart .Replace What:=Chr(13), Replacement:=Chr(10), lookat:=xlPart .Replace What:=Chr(10) & Chr(10), Replacement:=Chr(10), lookat:=xlPart End With End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Löschen von Zeilen innerhalb einer Zelle

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

345 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Löschen von Zeilen innerhalb einer Zelle

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

345 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread