Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Wörter aus Zelle hervorheben
#1
Hallo zusammen,

ich möchte das alle Wörter die in Zelle A stehen in Zelle B farbig hervorgehoben werden. 

Beispieldatei: 
.xlsx   Farbige Markierung.xlsx (Größe: 8,85 KB / Downloads: 6)

Gibt es die Möglichkeit das mit einer Formatierung zu lösen ohne dass alle Wörter in eigene Zellen aufgeteilt werden müssen? Es ist wichtig das zumindest die aneinander gereihten Wörter in einer Zelle stehen. Eventuell mit der Such-Funktion? Ich muss dies für mehr als 2000 Produkte machen, darum wäre es sehr aufwendig das für alle Produkte einzeln zu machen. 

Ich bin für jede Hilfe dankbar.

LG
Laura
Antwortento top
#2
Hola,

bitte eine Exceldatei an Stelle von Bildchen hochladen.

Gruß,
steve1da
Antwortento top
#3
Hallo Steve,

danke für die Info. Ich habe die Datei eingefügt.

Gruß,
Laura
Antwortento top
#4
Hallo,

sieh mal ein paar Zeilen weiter unten

https://www.clever-excel-forum.de/Thread...Einfaerben

dem post #3

mfg
Antwortento top
#5
Hallo,
vielen Dank für die Antwort.

Ich habe jetzt folgendes Makro angewendet:

Code:
Sub Test()

Dim Suche As String
Dim Laenge As Integer

Laenge = Len(Worksheets("Sheet2").Cells(1, 1))

Suche = InStr(1, Worksheets("Sheet2").Cells(1, 2), Worksheets("Sheet2").Cells(10, 1))

Worksheets("Sheet2").Cells(1, 2).Characters(Suche, Laenge).Font.ColorIndex = 3

End Sub

Die Datei sieht nun folgendermaßen aus: 
.xlsm   Farbige Markierung.xlsm (Größe: 16,11 KB / Downloads: 1)
Leider markiert er jetzt bloß soweit wie die Länge aus A1. Ich möchte jedoch, dass er explizit nach den Wörtern sucht. Gibt es die Möglichkeit, dass ein Wort mit Leerzeichen als ein "Suchwort" angesehen wird? Ich bin leider absoluter Anfänger was Makros angeht.


Gruß,
Laura
Antwortento top
#6
Hallo Laura,

Du könntest die Leerzeichen in A2 eintragen oder im Code die Leerzeichen drumherum bauen

Suche = InStr(1, " " & Worksheets("Sheet2").Cells(1, 2) & " ", Worksheets("Sheet2").Cells(10, 1))

Allerdings gäbe es da ein Problem. Das würde das Wort am Anfang oder Ende nicht finden. Da würden zusätzlich zu der vorhandenen Suche noch diese Zeilen helfen:

if Suche = 0 then
'Suche am Anfang
Suche = InStr(1, Worksheets("Sheet2").Cells(1, 2) & " ", Worksheets("Sheet2").Cells(10, 1))
end if
if Suche = 0 then
'Suche am Ende
Suche = InStr(1, " " & Worksheets("Sheet2").Cells(1, 2), Worksheets("Sheet2").Cells(10, 1))
end if

Sollte es das Wort mehrmals geben, müsste man das auch in einer Schleife verarbeiten, ansonsten wird nur der erste Treffer gefärbt
Sollte das Wort am Anfang stehen und z.B. ein Satzzeichen folgen, würde es nicht gefunden, z.B. Suche nach "Morgens" in diesem Satz
Morgens, wenn die Sonne aufgeht ...
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#7
Hallo,

die Datenstruktur, insbesondere wenn Suchbegriffe Worteile sind ("in" und "Kinder") ist kompliziert.

Hier ein Vorschlag:

Code:
Sub F_en()

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    sw = Split(Cells(i, 1))
    Tx = Replace(Cells(i, 2), Chr(10), Chr(32))
    mx = Split(Tx)
    For b = LBound(sw) To UBound(sw)
        Debug.Assert sw(b) <> "in"
        anz = Filter(mx, sw(b))
        If UBound(anz) = -1 Then GoTo NN
        rep = UBound(anz) + 1
        st = 1
        pp = 0
        Do
        rep = rep - 1
        If Len(sw(b)) = Len(anz(pp)) Then
            pos = InStr(st, Cells(i, 2), sw(b), vbTextCompare)
            st = pos + 1
            If pos > 0 Then
                Debug.Print sw(b), pos, UBound(anz), rep
                Cells(i, 3).Characters(pos, Len(sw(b))).Font.Color = vbRed
            End If
        Else: pp = pp + 1
        End If
        Loop Until rep <= 0
NN:
    Next b
Next i
End Sub

Zum Testen habe ich B1 in C1 kopiert.

mfg


Angehängte Dateien
.xlsm   Farbige Markierung.xlsm (Größe: 15,95 KB / Downloads: 5)
Antwortento top
#8
@Fennek,

wenn in b1 aus kinder dann blackinderpoint gemacht wird, wird der Schwarze Punkt auf dem Inder auch gefunden Sad

der Pullover mit blaubeeren statt blau übrigens nicht Smile
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#9
Hallo,

der Code ist besser:

Code:
Sub F_en2()

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    sw = Split(Cells(i, 1))
    Tx = Replace(Cells(i, 2), Chr(10), Chr(32))
    mx = Split(Tx)
    For b = LBound(sw) To UBound(sw)
        For m = LBound(mx) To UBound(mx)
            If sw(b) = mx(m) Then
            Debug.Print mx(m)
            p = 1
            Do
                pos = InStr(p, Cells(i, 2), mx(m), vbTextCompare)
                Cells(i, 2).Characters(pos, Len(sw(b))).Font.Color = vbRed
                p = pos + 1
            Loop While pos > 0
            Exit For
            End If
        Next m
    Next b
Next i
End Sub

mfg
Antwortento top
#10
Hallo,
vielen Dank für die Mühe!

Ich habe nun versucht das Makro anzuwenden. Leider funktioniert das noch nicht so richtig.

Siehe folgende Datei: 
.xlsx   Search Term.xlsx (Größe: 11,7 KB / Downloads: 2)

Hier erkennt er das Wort "Glue" zum Beispiel nicht. Hat jemand eine Idee?

LG
Laura
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste