Wörter aus Zelle hervorheben

[hddiesel]

Hallo Laura,

mit folgendem Zusatz, sollte das Mehrfach- Leerzeichenproblem gelöst werden.

Code:

Sub F_en3()
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Do While InStr(1, Cells(i, 1), "  ", 0) > 1
            Cells(i, 1) = Replace(Cells(i, 1), Chr(32) & Chr(32), Chr(32))
        Loop
        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 LCase(sw(b)) = LCase(mx(m)) Then
                    Debug.Print mx(m)
                    p = 1
                    Do
                        pos = InStr(p, LCase(Cells(i, 2)), LCase(mx(m)), vbTextCompare)
                        If pos > 0 Then 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