Remplir collonne automatiquement en fonction du thème

Sub recherche_texte()
Dim correspondance()
Dim theme_contenu(1 To 3, 1 To 2)
exclusion = Array("et", "la", "le", "autre", "les", "autres", "de", "l", "d", "a", "à")


'lecture des libellés thèmes
ReDim correspondance(1 To 2, 1)
Dim ligne As Integer
ligne = 0
For i = 2 To Feuil3.[A65000].End(xlUp).Row
    contenu = Replace(Feuil3.Cells(i, 1).Value, "'", " ")
    theme = Feuil3.Cells(i, 2).Value
    contenu_ligne = Split(contenu, " ")
    'remplir le tableau en supprimant les exclusions
    For y = 0 To UBound(contenu_ligne)
        exclure = False
        For l = 0 To UBound(exclusion)
            If UCase(contenu_ligne(y)) = UCase(exclusion(l)) Or contenu_ligne(y) = "" Then exclure = True
        Next l
        If Not exclure Then
            'ajouter au tableau
            ReDim Preserve correspondance(1 To 2, ligne)
            correspondance(1, ligne) = contenu_ligne(y)
            correspondance(2, ligne) = theme
            ligne = ligne + 1
        End If
    Next y
Next i

'lecture dont le theme est a chercher

For ligne_texte = 2 To Feuil2.[A65000].End(xlUp).Row
    contenu_entier = Replace(Feuil2.Cells(ligne_texte, 1), "'", " ")
    contenu = Split(contenu_entier, " ")
    For i = 1 To 3
    theme_contenu(i, 1) = ""
    theme_contenu(i, 2) = 0
    Next i
    
    For i = 0 To UBound(correspondance, 2)
        For y = 0 To UBound(contenu)
            If UCase(correspondance(1, i)) = UCase(contenu(y)) Then
                If theme_contenu(1, 1) = "" Or theme_contenu(1, 1) = correspondance(2, i) Then
                    theme_contenu(1, 1) = correspondance(2, i)
                    theme_contenu(1, 2) = theme_contenu(1, 2) + 1
                ElseIf theme_contenu(2, 1) = "" Or theme_contenu(2, 1) = correspondance(2, i) Then
                    theme_contenu(2, 1) = correspondance(2, i)
                    theme_contenu(2, 2) = theme_contenu(2, 2) + 1
                ElseIf theme_contenu(3, 1) = "" Or theme_contenu(3, 1) = correspondance(2, i) Then
                    theme_contenu(3, 1) = correspondance(2, i)
                    theme_contenu(3, 2) = theme_contenu(3, 2) + 1
                End If
            End If
        Next y
    Next i
    
    
    If theme_contenu(1, 2) >= theme_contenu(2, 2) Then
        theme_principal = theme_contenu(1, 1)
    ElseIf theme_contenu(2, 2) >= theme_contenu(3, 2) Then
        theme_principal = theme_contenu(2, 1)
    Else
        theme_principal = theme_contenu(3, 1)
    End If
    
    If theme_principal = "" Then theme_principal = "NC"
    Feuil2.Cells(ligne_texte, 3) = theme_principal
Next ligne_texte

End Sub