Remplir collonne automatiquement en fonction du thème

[nakadon]

Bonjour,

J'ai environ 3000 lignes à renseigner. Pour chaque formation je dois renseigner le thème correspondant.
Tous les thèmes se trouvent sur la feuille thème.
Est-ce possible via une macro ou une formule de renseigner automatiquement la colonne thème "feuil1".
Dès qu'au moins un mot de la colonne "Libellé Formation" de l'onglet "feuil1" correspondant à celui de "Libellé Formation" de l'onglet "thème", on renseigne la colonne thème dans onglet "feuil1".
Si possible, prendre le thème qui correspond à un maximum de mot trouvés. Les conjonctions et autres mots très courts (et, la, ou, du,...) peuvent être ignorées pour comparer un maximum de mots.
S'il n'y a aucun thème pour le libellé formation, alors on écrit "NC" dans le champ Thème
(voir un petit exemple en pièce jointe ci-dessous).

Je vous remercie bcp d'avance.

 

[Odesta]

Re : Remplir collonne automatiquement en fonction du thème

Bonjour

Et voici un code à mettre dans une macro :

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

Il faut remplir la liste d'exclusion (j'ai un peu commencé)
Normalement, il en tien pas compte de la casse
Dans l'aglo, les " ' " sont ignorés (remplacés par des espaces)
En cas de sujet présent sur plusieurs themes, il prend le plus fréquent, mais que parmis les 3 premiers themes qu'il trouve, la gestion de la priorité est toute à refaire si il est possible qu'il y ait plus de 3 themes !
Il faudrai un peu de temps pour rajouter un algo qui gère les "s" !

Olivier

 

[Odesta]

Re : Remplir collonne automatiquement en fonction du thème

Voici le fichier

 

[nakadon]

Re : Remplir collonne automatiquement en fonction du thème

Merci infiniment Odesta,

Je me suis très mal exprimé dans mon message.
D'abord, j'ai modifié entre temps le tableau (voir ci-dessus) pour que ça correspondante mieux à la réalité, ce qui m'évitera de modifier le code ainsi éviter les erreurs.
De plus, je l'ai mal dit dans mon premier message, c'est l'onglet "feuil1" (colonne thème) qu'il faut renseigner automatiquement. L'onglet "Resultat attendu" n'est qu'un modèle pour donner une idée du résultat que j'aimerais avoir dans l'onglet 'feuil1". Désolé, si le 1er message n'était pas clair. J'espère avoir donné un maximum d'info. Je suis disponible pr tout compléments d'info.

Dans cette attente, je vous remercie d'avance.

 

[Odesta]

Re : Remplir collonne automatiquement en fonction du thème

Le code est le même aux variables de colonnes et aux noms de feuilles près.

 

[nakadon]

Re : Remplir collonne automatiquement en fonction du thème

Cher Odesta !
J’ai évidemment tenté d'adapter ton code, mais je me retrouve avec plein d'erreurs. C'est dommage, car ta réponse répond vraisemblablement à ma demande. C'est pour ça que j'ai donné les précisions nécessaires dans mon message ci-dessous. Si tu peux adapter ton code au fichier joint dans mon premier message, je te serai reconnaissant.

Merci d'avance pour ta générosité.

 

[Odesta]

Re : Remplir collonne automatiquement en fonction du thème

Il n'y a pas de formation Excel à la Justice ?
Je plaisante.

Bien évidemment, je vous rejoints le fichier dès demain avec les bonnes valeurs, j'admets que mon code manque de commentaires pour être accessible.

 

[Odesta]

Re : Remplir collonne automatiquement en fonction du thème

Bonjour
Et voila