30.09.2020, 18:27
Hallo Laura,
mit folgendem Zusatz, sollte das Mehrfach- Leerzeichenproblem gelöst werden.
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