Sub HighlightRanges()
Dim doc As Document: Set doc = ActiveDocument
Dim SRange As Range: Set SRange = doc.Range
Dim RePaintText As Variant
Dim i As Long

    RePaintText = Array("Pos.", "Wert", "077.0087")
    
    Application.ScreenUpdating = False
    
    ClearFindnReplace
    Options.DefaultHighlightColorIndex = wdViolet
    With SRange.Find
        .Text = "Pos.*Wert"
        .Replacement.Highlight = True
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With

    ClearFindnReplace
    Options.DefaultHighlightColorIndex = wdYellow
    With SRange.Find
        .Replacement.Highlight = True
        For i = LBound(RePaintText) To UBound(RePaintText)
            .Text = RePaintText(i)
            .Execute Replace:=wdReplaceAll
        Next i
    End With

End Sub

Sub ClearFindnReplace()

    With Selection.Find
       .ClearFormatting
       .Replacement.ClearFormatting
       .Text = ""
       .Replacement.Text = ""
       .Forward = True
       .Wrap = wdFindStop
       .Format = False
       .MatchCase = False
       .MatchWholeWord = False
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
    End With
    
End Sub