Es soll hier glaube ich ja sowieso nur das erste markiert werden!?

Ne, es sollen alle weiteren Vorkommen des gleichen Worts markiert werden.

Sind mehrere Wörter gleich einfach/kompliziert, soll wiederum das im Text erste davon bei allen Vorkommen gefärbt werden

Darum steht bei 'cm' in Klammern auch 3x. 'cm' ist das einfachste Wort im Text und kommt 3x vor.

Hab hier noch eine Alternative erstellt - mir war gestern langweilig. Da ist dieser Teil der Aufgabe mit enthalten.

Option Explicit

Sub Test_Alternative()
  
  Dim rngWord As Word.Range
  Dim colMin  As VBA.Collection
  Dim colMax  As VBA.Collection
  Dim k_min   As Long
  Dim k_max   As Long
  Dim k       As Long
  
  'Formatierung aus vorherigen Durchgang rückgängig machen
  ThisDocument.Range.Font.Reset
  ThisDocument.Range.HighlightColorIndex = wdAuto
  
  'Wortweise durch den Text bewegen
  For Each rngWord In ThisDocument.Words
    
    'Leerzeichen am Ende eines Wortes weglassen - seltsames Verhalten von Word ¯\_('-')_/¯
    rngWord.MoveEndWhile " ", wdBackward
    
    'unsere Hilfsfunktion aufrufen (siehe unten)
    k = Complexness(rngWord.Text)
    
    If k > 0 Then
      
      If k < k_min Or k_min = 0 Then
        
'        If Not colMin Is Nothing _
'          Then Debug.Print "[k_min]"; Tab(12); "*entfernt*"
'
'        Debug.Print "[k_min]"; Tab(12); "*neu*"; Tab(24); "'"; rngWord.Text; "'"
        
        k_min = k
        Set colMin = New VBA.Collection
        Call colMin.Add(rngWord, rngWord.Text)
        
      ElseIf k = k_min Then
        'wenn es sich um das gleiche (identische) Wort handelt
        'nehmen wir es mit auf
        On Error Resume Next
        Call colMin(rngWord.Text)
        If Err.Number = 0 Then
'          Debug.Print "[k_min]"; Tab(12); "+1"; Tab(24); "'"; rngWord.Text; "'"
          Call colMin.Add(rngWord)
        End If
        On Error GoTo 0
      End If
      
      If k > k_max Or k_max = 0 Then
        
'        If Not colMax Is Nothing _
'          Then Debug.Print "[k_max]"; Tab(12); "*entfernt*"
'
'        Debug.Print "[k_max]"; Tab(12); "*neu*"; Tab(24); "'"; rngWord.Text; "'"
        
        k_max = k
        Set colMax = New VBA.Collection
        Call colMax.Add(rngWord, rngWord.Text)
        
      ElseIf k = k_max Then
        'wenn es sich um das gleiche (identische) Wort handelt
        'nehmen wir es mit auf
        On Error Resume Next
        Call colMax(rngWord.Text)
        If Err.Number = 0 Then
'          Debug.Print "[k_max]"; Tab(12); "+1"; Tab(24); "'"; rngWord.Text; "'"
          Call colMax.Add(rngWord)
        End If
        On Error GoTo 0
      End If
      
'    Else
'      Debug.Print Tab(12); "*ignoriert*"; Tab(24); "'"; rngWord.Text; "'"
    End If 'k > 0
    
  Next
  
  For Each rngWord In colMin
    rngWord.HighlightColorIndex = WdColorIndex.wdGreen
    rngWord.Font.ColorIndex = WdColorIndex.wdWhite
  Next
  
  For Each rngWord In colMax
    rngWord.HighlightColorIndex = WdColorIndex.wdRed
    rngWord.Font.ColorIndex = WdColorIndex.wdWhite
  Next
  
End Sub

'Hilfsfunktion
' - Alternative mit Mid()- und InStr()-Funktion
' stellt fest wie kompliziert/komplex ein Wort ist
Private Function Complexness(Word As String) As Long
  
  Dim strChr  As String * 1
  Dim i       As Long
  Dim k       As Long
  
  For i = 1 To Len(Word)
    strChr = Mid$(Word, i, 1)
    Select Case strChr
      Case "a" To "z", "A" To "Z", "ä", "ö", "ü", "Ä", "Ö", "Ü", "ß"
        If InStr(Mid$(Word, 1, i - 1), strChr) = 0 Then
          k = k + 1
        End If
    End Select
  Next

  Complexness = k

End Function

Was die Sache mit Ribbon angeht: Da solltest du deine Aufzeichnungen ansehen; ich gehe auf das Thema hier nicht weiter ein - der Löwenanteil der Aufgabe ist das Makro oben.

Grüße