Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1824to1828
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeichen entfernen, Tiefstellung behalten

Zeichen entfernen, Tiefstellung behalten
09.04.2021 08:31:46
ChrisS.
Moin liebes Forum,
ich will aus einem Worksheet mehrere Textzeilen (Überschriften) kopieren, einfügen und einige Zeichen löschen.
In diesen Überschriften befinden sich zum Teil Indices also tiefgestellte Buchstaben oder Zahlen.
Kopieren tue ich das ganze mit Copy... Destination:=... Soweit so gut. Wenn ich jedoch Zeichen ersetze ist die Tiefstellung weg. Habe einige Wege ausprobiert. Habe dazu mal eine Beispielmappe erstellt in der alle mir bekannten Möglichkeiten Zeichen zu löschen aufgezeigt sind.
https://www.herber.de/bbs/user/145408.xlsm
Konkret zur Beispielmappe: Ich will "4.1 " löschen und "ABC" und "12" sollen im nachhinein weiterhin tiefgestellt sein.
MfG
ChrisS.

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeichen entfernen, Tiefstellung behalten
09.04.2021 08:51:00
onur
Wenn du mal testen würdest: die Tiefstellung ist auch weg, wenn du ohne jegliches Kopieren direkt in A1 was änderst.
Hat nix mit dem Kopieren zu tun.
Die geänderten Formatierungen eines Teils des Textes betreffen nur bestimmte (z.B'. das dritte ) Zeichen, wenn du aber da was am Text änderst, ist diese Zuordnung ja weg, da das dritte Zeichen ja nicht mehr das dritte wäre.
AW: Zeichen entfernen, Tiefstellung behalten
09.04.2021 08:52:46
ChrisL
Hi
Hier eine hübsche VBA-Lösung:
https://www.extendoffice.com/documents/excel/3760-excel-find-and-replace-preserve-formatting.html
Sub t()
Call CharactersReplace(Range("A1"), "4.1 ", "")
End Sub

Sub CharactersReplace(Rng As Range, FindText As String, ReplaceText As String, Optional  _
MatchCase As Boolean = False)
'UpdatebyExtendoffice20160711
Dim I As Long
Dim xLenFind As Long
Dim xLenRep As Long
Dim K As Long
Dim xValue As String
Dim M As Long
Dim xCell As Range
xLenFind = Len(FindText)
xLenRep = Len(ReplaceText)
If Not MatchCase Then M = 1
For Each xCell In Rng
If VarType(xCell) = vbString Then
xValue = xCell.Value
K = 0
For I = 1 To Len(xValue)
If StrComp(Mid$(xValue, I, xLenFind), FindText, M) = 0 Then
xCell.Characters(I + K, xLenFind).Insert ReplaceText
K = K + xLenRep - xLenFind
End If
Next
End If
Next
End Sub

cu
Chris
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige