Hallo,

freut mich...

das höhere Tempo liegt am Variant-Array, dadurch werden die Zellbereiche nicht mehr einzeln abgearbeitet, hiermit gehts noch etwas schneller...

Option Explicit

Public Sub Adjektive()
Const xlUp As Long = -4162 '// Konstante der Excel-App...
Dim AktWord As Range
Dim AllWord() As String, iWord As Long, Found As Boolean
Dim TmpStr As String

' Exceldaten aus offener Arbeitsmappe einlesen
' Aktuell 1. Spalte Zeile 1-5000
Dim xlApp As Object ' Excel.Application
Dim avntSearchWords() As Variant
Dim ialngIndex As Long, lngCount As Long
Set xlApp = GetObject(Class:="Excel.Application")
With xlApp
    avntSearchWords = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1).Value '// <--- an Stelle von --  Range("A1:A5000") -- besser so....
End With
For ialngIndex = 1 To UBound(avntSearchWords, 1)
    If Len(avntSearchWords(ialngIndex, 1) & "") > 0 Then
      ReDim Preserve AllWord(iWord) As String
      AllWord(iWord) = UCase$(avntSearchWords(ialngIndex, 1))
      iWord = iWord + 1
    End If
Next
' Worddokument durchsuchen und Wörter Rot färben
With ActiveDocument.Range
    For Each AktWord In .Words
       With AktWord
            TmpStr = Trim$(.Text)
            lngCount = .Characters.Count
            For iWord = 0 To UBound(AllWord)
                 If UCase$(TmpStr) Like AllWord(iWord) & "*" Then
                     If Len(TmpStr) = lngCount Then
                        Call prcSetBorders(probjBorder:=.Font.Borders(1))
                     Else
                        Call prcSetBorders(probjBorder:= _
                          ActiveDocument.Range(Start:=.Characters(1).Start, _
                            End:=.Characters(lngCount).Start).Font.Borders(1))
                     End If
                     Exit For
                 End If
            Next
       End With
    Next
End With
Set xlApp = Nothing
End Sub

Private Sub prcSetBorders(ByRef probjBorder As Border)
With probjBorder
    .LineStyle = wdLineStyleSingle
    .LineWidth = wdLineWidth150pt
    .ColorIndex = wdRed '//wdBrightGreen
End With
End Sub

...hinsichtlich der unterschiedl. Farben könntest Du im Code einfach die aktiven TabBlätter der Excelmappe abfragen, dann benötigst Du den Code nicht mehr mehrfach, viell. schick ich später noch ein Bsp.....

Gruß,