Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
784to788
784to788
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zeichen links und Rechts des Suchtextes löschen

Zeichen links und Rechts des Suchtextes löschen
24.07.2006 16:26:03
Gregor
Hallo Wissende
Untenstehender Code funktioniert soweit einwandfrei. Er formatiert die in Klammern stehenden Wörter fett. Wie erreiche ich, dass nach der Formatierung die Klammern gelöscht werden?
Merci für deinen Rat.
Gregor

Sub Fett_Schrift()
Dim intStart As Integer, intEnde As Integer
Dim rng As Range
Anzahl = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In Range("d1:e100" & Anzahl)
If Len(rng) > 0 Then
intStart = InStr(1, rng, "(")
intEnde = InStr(1, rng, ")")
If intStart > 0 And intEnde > 0 Then
Do
rng.Characters(intStart + 1, intEnde - intStart - 1).Font.Bold = True
'gleichzeitig "(" und ")" löschen  ?
intStart = InStr(intEnde + 1, rng, "(")
intEnde = InStr(intEnde + 1, rng, ")")
Loop While intStart > 0 And intEnde > 0
End If
End If
Next
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeichen links und Rechts des Suchtextes löschen
24.07.2006 16:30:51
ChrisL
Hallo Gregor
rng = WorksheetFunction.Substitute(rng, "(", "")
rng = WorksheetFunction.Substitute(rng, ")", "")
Gruss
Chris
AW: Zeichen links und Rechts des Suchtextes lösche
24.07.2006 16:41:38
Gregor
Hallo Chris
Danke für deinen Ansatz. Es ist gut, nur leider geht die Fett-Formatierung dadurch verloren.
Ziel ist es:
- zuerst Klammerinhalt fett formatieren
- danach Klammern löschen, ohne Formatierung zu verlieren.
Was jemand die Lösung?
Danke für deinen Input!
Grüsse Gregor
AW: Zeichen links und Rechts des Suchtextes lösche
24.07.2006 16:44:52
K.Rola
Hallo,
Sub Fett_Schrift()
Dim intStart As Integer, intEnde As Integer
Dim rng As Range
Anzahl = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In Range("d1:e100" & Anzahl)
If Len(rng) > 0 Then
intStart = InStr(1, rng, "(")
intEnde = InStr(1, rng, ")")
If intStart > 0 And intEnde > 0 Then
Do
rng.Replace "(", ""
rng.Replace ")", ""
rng.Characters(intStart, intEnde - intStart - 1).Font.Bold = True
intStart = InStr(intEnde + 1, rng, "(")
intEnde = InStr(intEnde + 1, rng, ")")
Loop While intStart > 0 And intEnde > 0
End If
End If
Next
End Sub
Gruß K.Rola

Anzeige
AW: Zeichen links und Rechts des Suchtextes lösche
24.07.2006 16:52:16
Gregor
Hallo K. Rola
Wir kommen der Lösung näher:
Folgendes Problem ist noch nicht gelöst:
In der Zelle hat es mehrere fett zu formatierende Stellen (z.B. "Es ist (normal), dass dieser Wert (so hoch) ist. normal + so hoch = fett).
Gibt es eine Lösung?
Merci für weitere Vorschläge!
Gregor
AW: Zeichen links und Rechts des Suchtextes lösche
24.07.2006 17:27:16
K.Rola
Hallo,
eine Lösung gibt es (fast) immer, kann mich aber erst nach 20:00 Uhr damit
beschäftigen.
Gruß K.Rola
AW: Zeichen links und Rechts des Suchtextes lösche
24.07.2006 19:17:12
fcs
Hallo Gregor,
habe mich auch mit deiner Frage beschäftigt und bin beim Testen über all die beschriebenen Probleme gestolpert. Es bleibt nichts anderes über, als zunächst in einer Schleife die Positionen der Klammerpaare zu ermitteln und in einer Feld-Variablen zu speichern.
In einer 2. Schleife werden dann die Textteile fett formatiert.

Sub Fett_Schrift()
' Formatiert Textteiel die in Klammern stehn FETT und löscht Klammern
Dim intStart As Integer, intEnde As Integer, I As Integer
Dim rng As Range, arrPos() As Integer
Anzahl = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'  For Each rng In Range("d1:e100" & Anzahl)' ======Alt======
For Each rng In Range("d1:e" & Anzahl)    ' ======Korrektur======
If Len(rng) > 0 Then
ReDim arrPos(1 To 10, 1 To 2)
intStart = InStr(1, rng, "(")
intEnde = InStr(1, rng, ")")
If intStart > 0 And intEnde > 0 Then
'Ermittlung der Position von Klammerpaaren
I = 1
Do
arrPos(I, 1) = intStart
arrPos(I, 2) = intEnde - 1
' Klammern ersetzen durch nichts
rng = Application.WorksheetFunction.Replace(rng.Value, intStart, 1, "")
rng = Application.WorksheetFunction.Replace(rng.Value, intEnde - 1, 1, "")
intStart = InStr(intEnde - 1, rng, "(")
intEnde = InStr(intEnde - 1, rng, ")")
I = I + 1
Loop While intStart > 0 And intEnde > 0
'Textteile entsprechend ermitelter Positionen Fett formatieren
For I = 1 To UBound(arrPos, 1)
If arrPos(I, 1) = 0 Then Exit For
rng.Characters(arrPos(I, 1), arrPos(I, 2) - arrPos(I, 1)).Font.Bold = True
Next
End If
End If
Next
ReDim arrPos(1, 1)
End Sub

gruss Franz
Anzeige
AW: Zeichen links und Rechts des Suchtextes lösche
24.07.2006 20:04:04
Gregor
Hallo Franz, K. Rola
Ich staune!
Das war's: hätt es nicht für möglich gehalten!
Merci für eure geniale Programmierkunst.
Grüsse
Gregor

336 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige