Einzelne Wörter in Zellen markieren

Question

Auf der Suchen nach der Möglichkeit, ein einzelnes Wort, das mehrmals in verschiedenen Spalten/Zellen einer Exceltabelle vorkommt, farbig oder fett zu markieren, bin ich u.a. auf die in diesem Forum vorgestellte VBA-Lösung gestossen:
https://supportnet.de/fresh/2007/3/id1516171.asp

Diese Lösung funktioniert, aber nicht für mein Problem. Ich will das gesuchte Wort direkt im Makro angeben und es soll dann in der ganzen Tabelle gesucht, gefunden und markiert werden.Das Ganze soll im übrigen in ein bereits bestehendes Makro eingefügt werden...

(Bin VBA-Laie, das bestehende konnte ich immerhin mittels 'Makro aufzeichnen' hinkriegen)
Danke für Hilfestellung

Answer 1

Hallo,

hier ein Makro, das dir sämtliche Zellen durchsucht und das Suchwort farbig markiert. Im Beispiel wird das Wort "Suchwort" gesucht. Hier musst du deinen gewünschten Suchbegriff eingeben.

Sub SuchtextFarbig()
Dim strSuch As String
Dim rngZelle As Range

'Suchbegriff, anpassen
strSuch = "Suchwort"

'Jede Zelle im genutzten Bereich durchlaufen
For Each rngZelle In ActiveSheet.UsedRange
  'Falls das Suchwort in Zelle gefunden wurde, dann das Suchwort farbig markieren
  If InStr(1, rngZelle.Value, strSuch) Then rngZelle.Characters(InStr(1, rngZelle.Value, strSuch), Len(strSuch)).Font.ColorIndex = 5
Next rngZelle

End Sub

Alles was zwischen Sub SuchtextFarbig und End Sub steht musst du in dein bestehendes Makro einfügen. Mehr kann man im Moment dazu nicht sagen, da du dein Makro nicht gepostet hast.

Gruß

M.O.

Answer 2

Hallo M.O.

Vielen Dank, klappt tadellos!
Nun möchte ich aber auch noch eine weitere solche Aktion einfügen (anderes Suchwort, andere Markierung). Mit zweimal einfügen deines Makros klappt es (wohl verständlicherweise) nicht: "Mehrfachdeklaration im aktuellen Gültigkeitsbereich".

Ausschnitt aus meinem Gesamtmakro:

Columns("A:A").Select
    Selection.Font.Bold = True
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
' hier will ich deine Abfrage zweimal einfügen (2 unterschiedliche Suchbegriffe)
    Columns("B:B").Select
    With Selection
         ....... etc.....

Answer 3

Hallo,

füge die beiden Zeilen, die mit DIM beginnen gleich zu Anfang an (nach Sub ..)

Das würde dann z.B. so aussehen (dein aufgezeichnetes Makro etwas optimiert):

Sub DeinMakro()
Dim strSuch As String
Dim rngZelle As Range

With Columns("A:A")
    .Font.Bold = True
    .VerticalAlignment = xlCenter
    'die folgenden Punkte kannst du dir eigentlich sparen; sind die Standardeinstellungen   
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
 End With

'Suchbegriff, anpassen
strSuch = "Suchwort"

'Jede Zelle im genutzten Bereich durchlaufen
For Each rngZelle In ActiveSheet.UsedRange
  'Falls das Suchwort in Zelle gefunden wurde, dann das Suchwort farbig markieren
  If InStr(1, rngZelle.Value, strSuch) Then rngZelle.Characters(InStr(1, rngZelle.Value, strSuch), Len(strSuch)).Font.ColorIndex = 5
Next rngZelle

'Suchbegriff 2, anpassen
strSuch = "Begriff"

'Jede Zelle im genutzten Bereich durchlaufen
For Each rngZelle In ActiveSheet.UsedRange
  'Falls das Suchwort in Zelle gefunden wurde, dann das Suchwort farbig markieren
  If InStr(1, rngZelle.Value, strSuch) Then rngZelle.Characters(InStr(1, rngZelle.Value, strSuch), Len(strSuch)).Font.ColorIndex = 4
Next rngZelle
    
'hier geht dann dein Makro weiter   
 

End Sub

Gruß

M.O.

Answer 4

Hallo M.O.

Perfekt! Vielen Dank, du hast mir sehr geholfen.

Gruss