Bestimmten Text innerhalb einer Zelle hervorheben

[bastian_der_neuling]

Hallo zusammen und Willkommen zu meinem ersten Anliegen. :)


Ich habe mich mittlerweile durch viele Foren, Beiträge, etc. durchgeforstet aber konnte leider nirgendwo die richtige Lösung zu meinem Anliegen finden.

Und zwar möchte ich einen bestimmten unbestimmten Text aus einer einzelnen hervorheben. Ich habe hier nach zwei Möglichkeiten gesucht: Den Text innerhalb der Zelle farblich hervorheben ODER den Text in einer Zelle daneber einzukopieren damit dieser für sich alleine steht. Fokus ist hier, eine bessere Erkennbarkeit zu schaffen.

Der Text selber: Beginnt vorne dran mit AT gefolgt von einer immer 8-stelligen Zahlenkette. "AT20230001" und "AT20220156" als Beispiel.

Dieser steht in der Zelle innerhalb von Text, jedoch nie an der selben Stelle. Beispiel:

- Lorem ipsum 0123 dolor sit amet AT12345678 consetetur sadipscing - 01.01 - elitr

- AT12345678 Lorem ipsum dolor sit amet consetetur sadipscing elitr 21,0x29,7

- Lorem ipsum dolor sit amet consetetur sadipscing AT12345678 elitr (01.01.) At vero eos et accusam et justo duo dolores et ea rebum.

- Lorem ipsum dolor sit amet AT12345678consetetur sadipscing - 01.01 - elitr - 02.01

Leider ist die AT-Nummer nicht immer (eher nie) die einzige Zahl in der Zelle, weswegen auch eine Textkürzung via RBA auf rein Zahlenwerte nicht funktioniert.


Am besten wäre ein Lösungansatz den ich in Verbund mit einem Makro bringen kann. Ich arbeite innerhalb einer Excel-Tabelle für die ich keine Speicher-Rechte habe. Deswegen müsste ich die Funktion via Makro auslösen, meine Ausdrucke machen und dann wieder schließen ohne zu speichern.

VG
Bastian

[Fennek]

Hallo,

als Mustercode:

Code:

Sub F_en()
Dim Tx As String, pos As Integer

Tx = Cells(1, 1)
pos = InStr(1, Tx, "AT", vbBinaryCompare)
If pos Then
    If Mid(Tx, pos, 10) Like "AT########" Then
        Cells(1, 1).Characters(pos, 10).Font.Bold = True
    End If
End If
End Sub

mfg

[bastian_der_neuling]

Hallo Fennek,

erstmal vielen Dank für den Mustercode und Entschuldigung das ich mich jetzt erst melde. Die letzten Wochen waren etwas stressig mit Corona und Sachen erstmal wieder aufarbeiten.  

An sich funktioniert der Code und sollte mit kleinen Anpassungen das sein, was ich brauche. Nur hänge ich an den Anpassung fest.
Aktuell wird mir ja nur die Zeller A1 markiert, wenn ich versuche den Code auf eine Range auszuweiten bekomme ich die Fehlermeldung Laufzeitfehler ´13´: Typen unverträglich
Mein Code:

Code:

Sub F_en()
Dim Tx As String, pos As Integer

Tx = Range(Cells(1, 1), Cells(50, 1))
pos = InStr(1, Tx, "AT", vbBinaryCompare)
If pos Then
    If Mid(Tx, pos, 10) Like "AT########" Then
        Range(Cells(1, 1), Cells(50, 1)).Characters(pos, 10).Font.Bold = True
    End If
End If
End Sub

Eigentlich sollte ich so doch die Zellen A1:A50 auswählen können, oder?

[26865]

Eigentlich sollte ich so doch die Zellen A1:A50 auswählen können, oder?

Tx ist als STRING deklariert, kann also genau einen Text aufnehmen. Du versuchst aber, ein DATENFELD an diese Variable zu übergeben. Die Typen passen also nicht überein.

Bearbeite die Zellen nacheinander:

Code:

Option Explicit

Sub F_en()
Dim Tx As String, pos As Integer
Dim c As Range
For Each c In Range(Cells(1, 1), Cells(50, 1))
   Tx = c.Value
   pos = InStr(1, Tx, "AT", vbBinaryCompare)
   If pos Then
       If Mid(Tx, pos, 10) Like "AT########" Then
           c.Characters(pos, 10).Font.Bold = True
       End If
   End If
Next c
End Sub

[bastian_der_neuling]

Danke EarlFred, jetzt passt das für mich so. :)

[bastian_der_neuling]

Jetzt hätte ich doch gerade nochmal eine Frage in die Runde, da gefragt wurde ob man das auch umsetzten kann:

Da ich jetzt den Code habe um die AT mit der 8-stelligen Zahlenfolge auszulesen stellt sich die Frage, ob ich diese auch ausschneiden und an den Anfang der jeweiligen Zelle einfügen kann?
Also das die Zellen in Spalte A immer mit AT######## anfangen und dann der restlich vorhandene Text folgt.

Und wenn wir schon dabei sind: Wie kann ich einfacher selber herausfinden ob solche Funktionen möglich/vorhanden sind? Viele Sachen finde ich immer via Google aber das kann ja auch nicht das Ziel von VBA sein.

[26865]

ob man das auch umsetzten kann:

Ja. Wenn du anfängst, dich mit VBA auseinanderzusetzen, stößt du schnell auf Textfunktionen wie left(), mid()(kennst du ja schon) usw. Auch Replace() kann dabei helfen. Wichtige Ansätze sind ja bereits im gezeigten Code vorhanden.

Man findet zu allen Fragen dieser Art Antworten. Aber auch richtiges Googeln will gelernt sein. 
 
Da du selber lernen willst (gute Einstellung!), erspare ich dir konkrete Hilfe und überlasse dich Selbstversuchen.

[bastian_der_neuling]

Das wäre jetzt mein Lösungsvorschlag nach ewigen Zeiten. Hättest das anders/einfacher gelöst?

Code:

  Dim cell As Range
    Dim regEx As Object
    Dim match As Object
    Dim cutString As String
    Dim restString As String
   
    Set regEx = CreateObject("vbscript.regexp")
    regEx.Pattern = "AT\d{8}"
   
    For Each cell In Selection
        If regEx.test(cell.Value) Then
            Set match = regEx.Execute(cell.Value)(0)
            cutString = match.Value
            restString = Replace(cell.Value, cutString, "")
            cell.Value = cutString & "  " & restString
        End If
    Next cell

[26865]

RegExps sind toll dafür, aber für Einsteiger empfehle ich tendenziell erstmal die genannten Text-Methoden. Letztlich egal: Solange du weißt, was du da tust, sollte es für DICH OK sein.

[bastian_der_neuling]

So halbwegs. Frag nicht durch wie viele Foren, Beiträge und Microsoft-Infos ich mich durchgewühlt habe bis das lief :D