Replace Funktion erweitern

[schauan]

Hallo sotaros,

wie wäre denn zu erkenne, ob der Punkt am Ende weg muss oder nicht? In folgenden Beispielen steht eine Zahl am Satzende.

Heute ist der 17.
Der letzte Freitag diesen Monat ist der 31.
Office gibt es jetzt schon in der Version 2013.
Das ist meine 2. Antwort in diesem Thread.

Oder soll der Punkt nur dann weg, wenn der Zellinhalt ohne den Punkt numerisch ist?

[sotaros]

Hallo André,

diese Ausnahmen am Satzende sind sicherlich möglich, kommen aber in meinem Text (fast) nicht vor.
Ja, es ist kompliziert! Nehmen wir mal an die Zahlen stehen alle am Anfang oder in der Mitte des Satzes.
Würde mir zunächst auch schon stark weiterhelfen.

[Kuwer]

Hallo sotaros,

vielleicht einfach so:

Code:

Sub PunkZuKlammerZu()
  Dim i As Integer
  With Selection
    For i = 0 To 9
      .Replace What:=i & ".", Replacement:=i & ")", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Next i
  End With
End Sub

Gruß Uwe

[schauan]

Hallo Sotaros,

ich heb hier mal zwei Ansätze. Der erste ist für rein numerische Zellinhalte, der zweite für eine Zahl mit Punkt irgendwo in der Zeichenkette.

Code:

Sub prcTestRegex_Num1()
   'nur numerisch mit abschliessendem Punkt
   Dim re As Object
   Set re = CreateObject("vbscript.regexp")
   re.Pattern = "^[0-9]+\.$"
   If re.test("A12.") Then
   MsgBox Replace("A12.", ".", ")")
   End If
End Sub

Sub prcTestRegex_Num2()
   'numerisch mit abschliessendem Punkt irgendwo
   Dim re As Object
   Set re = CreateObject("vbscript.regexp")
   re.Pattern = "[0-9]+\. "
   If re.test("A12. O") Then
   MsgBox Replace("A12. O", ".", ")")
   End If
End Sub

[sotaros]

Hallo Leute,

sehe gerade eure Lösungsvorschläge. Werde sie morgen mal testen und entsprechende rückmelden.
Für eure Mühe und Hilfe aber schon heute ein ganz herzliches Dankeschön!

Schlaft gut!

[Steffl]

Hallo André,

ich heb hier mal zwei Ansätze. Der erste ist für rein numerische Zellinhalte, der zweite für eine Zahl mit Punkt irgendwo in der Zeichenkette.

Sub prcTestRegex_Num1()
'nur numerisch mit abschliessendem Punkt
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.Pattern = "^[0-9]+\.$"
If re.test("A12.") Then
MsgBox Replace("A12.", ".", ")")
End If
End Sub

re.test? Ich habe diese Eigenschaft oder Methode hier nicht gefunden. Wo hast Du die her? Letztendlich verwendest Du nur die Replace-Funktion von VBA.

[schauan]

Hallo Stefan,
Das ist das regex von VBScript, Google mal mit den beiden Stichworten. Da gibts .replace, .test, .execute ...

[ChristaRohn]

Hallo liebe Leutchen,

ich möchte gerne die Replace Funktion dahingehend erweitern
das der zu ersetzende Wert selbst zwar bleibt, aber in einer anderen Farbe,
sagen wir als Beispiel Blau, erscheint. So etwas wäre mich sehr praktisch.

[schauan]

Hallo Christa,

das ist jetzt zwar Excelrot , aber funktioniert trotzdem. Ich hatte übrigens kürzlich eine Lösung gepostet, wo Worte mit ing am Ende gefärbt werden.

Der code unterscheidet übrigens Groß- und Kleinschreibung. Wenn Du beides berücksichtigen willst, dann müsstest Du z.B. den Text und das "Trennzeichen" nur im code in Großbuchstaben wandeln.
Also dann ... strZeichen ... "CH" und bei Split mit Ucase den Zellinhalt in Großbuchstaben verarbeiten.

Durch die Zerlegung kann ich relativ einfach Start und Ende der Färbung ermitteln. Ich hab mal den Satz Ich schreibe keine leichten Charaktere. genommen und ch eingefärbt. Ch bleibt schwarz.

Code:

Sub StringColor()
Const strZeichen As String = "ch"
Const lColor As Long = -16776961
Dim iCnt As Integer, iPos As Integer, iLen As Integer
'Variant
'Objekte
Dim oZelle As Range
Dim arrSatz
  'Zelle A1 zuweisen
  Set oZelle = Cells(3, 1)
  'Zellinhalt uebernehmen und zerlegen
  arrSatz = Split(oZelle, strZeichen)
  'Laenge des Wortes ermitteln
  iLen = Len(strZeichen)
  'Startpos. festlegen
  iPos = 1
  'Schleife ueber alle Worte
  For iCnt = 0 To UBound(arrSatz)
      'Anfangsposition des Wortes berechnen
      iPos = iPos + Len(arrSatz(iCnt)) '+ Len(strZeichen)
      'Wenn ein Wort mit ing aufhoert, dann
        'Mit den Zeichen der Zelle vom Anfang bis Ende des Wortes
        With oZelle.Characters(Start:=iPos, Length:=iLen).Font
          'Farbe setzen
          .Color = lColor
        'Ende Mit den Zeichen der Zelle vom Anfang bis Ende des Wortes
        End With
      'Anfangsposition des Wortes berechnen
      iPos = iPos + Len(strZeichen)
  'Ende Schleife ueber alle Worte
  Next
End Sub

[ChristaRohn]

Hallo Andre,

bin gerade mal wieder im Forum und sehe Deinen Lösungsvorschlag. Vielen Dank dafür.
Ich dachte man könnte die Aufgabe eventuell mit der Replace Funktion leichter lösen.
Leider scheint Excel VBA keine trivial Lsg zu bieten. So muss der arme Programmierer
ran und schuften. Ich kopiere mir den Code für meine Sammlung und wünsche
Dir noch einen schönen Abend bzw. schöne nächste Woche.

Bis dann