Microsoft 365 Comparer le texte de deux colonnes (plusieurs mots/cellule) pour trouver 1 mot en commun

[Lagertha]

Bonjour à tous!
Je suis toute fraîchement arrivée ici et je vous découvre en faisant mes recherches depuis plusieurs jours sur ma problématique.
Je n'y ai pas encore trouvé de solution. Je vous l'expose en espérant que vos lumière me sauveront.

Je pars d'une liste de noms de dossier en colonne A (environ 22 000 lignes)

J'ajoute en colonne B, quotidiennement, une liste de dossiers qui me vient de l'internationale pour vérifier que nous n'avons pas les mêmes clients pour des missions qui seraient en conflit. Cette liste ne contient pas plus de 50 lignes.

La difficultés: chaque cellule de la colonne A et B comprend plusieurs mots (nom de la société, parfois la branche de la filiale, ...).
Il me faut tester chaque cellule de la colonne B pour vérifier qu'au moins un mot ne se trouve pas dans ma colonne A. Je ne cherche donc pas des cellules identiques (donc pas de RECHERCHE, etc...) mais des cellules qui auraient au moins un mot en commun (sans tenir compte de la casse).
J'ai testé quelques macros trouvées sur le site mais elles ne permettent la comparaison que de deux cellules de la même ligne. Je suis vraiment perdue.

Exemple joint.

Je vous remercie par avance pour toute l'aide que vous pourriez m'apporter

 

[Lagertha]

Bonsoir le fil,

Une autre version différente de mes collègues Excéliens
(Si j'ai bien compris le problème)
Tester les 2 feuilles svp

PS : la macro pointe sur la feuille active

ActiveSheet

Pour pointer sur la feuille voulue remplacer ActiveSheet par Sheet("NomDeLaFeuille"), dans tout le code …
Ex. :

     VA = ActiveSheet.Cells(1).CurrentRegion.Value

deviendra :

     VA = Sheet("Feuil1").Cells(1).CurrentRegion.Value

Le code :

Option Explicit

Sub FindWords()
Dim Wd As New Collection, VA, LRowB As Integer, V, x As Long, y As Integer, L As String, T!
 
    T = Timer
 
    VA = ActiveSheet.Cells(1).CurrentRegion.Value
    LRowB = Application.CountA(ActiveSheet.Cells(1).CurrentRegion.Offset(, 1).Resize(, 1))
 
    For x = 2 To UBound(VA)
        V = Split(Application.Trim(VA(x, 1)))
        L = "CLIENT "
        For y = LBound(V) To UBound(V)
            On Error Resume Next
            Wd.Add L, V(y)
            If Err Then Err.Clear
        Next
    Next
 
    For x = 2 To LRowB
        V = Split(Application.Trim(VA(x, 2)))
        L = ""
        For y = LBound(V) To UBound(V)
            On Error Resume Next
                L = Wd(V(y)) & "OK"
            If Err Then Err.Clear
        Next
        If Len(L) = 0 Then L = "RISQUE DE CONFLIT - CLIENT NOK"
        VA(x, 3) = L
    Next
 
    VA = Application.Index(VA, Application.Evaluate("Row(" & 2 & ":" & LRowB & ")"), 3)
 
Application.ScreenUpdating = False
    ActiveSheet.Cells(2, 3).Resize(UBound(VA), 1).Value = VA
Application.ScreenUpdating = True
 
    MsgBox Format(Timer - T, "0.0000s")
 
End Sub

Le fichier :

Bonjour @RyuAutodidacte , merci pour ce fichier.

La bonne nouvelle c'est que tout se déroule sans faire planter Excel.

Ensuite, et ce n'est qu'une remarque, je n'ai pas été très claire, je le regrette, mais le conflit est pile dans la situation inverse: mot en commun = conflit, mais finalement, ce n'est qu'une inversion des termes.

Enfin, la principale difficulté c'est qu'en comparant des morceaux de mots... presque la totalité des dossiers de la colonne B sont en conflits avec au moins une ligne de la colonne A.
Le terme entier "INC" en colonne B va entrer en conflit avec "Vincent" ou "Pince" en colonne A. Pourtant il n'y a aucun mot en commun, pas de conflit.

Ai-je été assez précise?

 

[Cousinhub]

Bonjour,

...la principale difficulté ....

Ai-je été assez précise?

Je pense que la principale difficulté, c'est justement ta dernière question...
Tu as mis un exemple, OK, mais est-il représentatif de ton véritable fichier?
Pourquoi ne pas mettre des données plus "réalistes"? (en modifiant certains noms si tu ne désires pas dévoiler ta liste de clientèle)
On peut penser que certaines cellules contiennent des "Les, Des, Inc., Ets......" (Liste non exhaustive) et que ces termes ne doivent pas faire l'objet de recherche de correspondance...
Si tu veux des réponses plus abouties, sois justement "plus précise"...
Bonne apm

 

[Lagertha]

Bonjour,


Je pense que la principale difficulté, c'est justement ta dernière question...
Tu as mis un exemple, OK, mais est-il représentatif de ton véritable fichier?
Pourquoi ne pas mettre des données plus "réalistes"? (en modifiant certains noms si tu ne désires pas dévoiler ta liste de clientèle)
On peut penser que certaines cellules contiennent des "Les, Des, Inc., Ets......" (Liste non exhaustive) et que ces termes ne doivent pas faire l'objet de recherche de correspondance...
Si tu veux des réponses plus abouties, sois justement "plus précise"...
Bonne apm

Bonjour @Cousinhub,

Encore une fois, si le fichier trouve "inc." en commun, ca ne posera pas de problème, ça se filtrera facilement. Le problème sera s'il trouve une concordance entre "vINCent" et pINCe" par exemple, puisque cela va se reproduire avec toutes les syllabes en commun. Je souhaitais un moyen de trouver des mots complets en commun.

Merci à tout le monde pour ce travail et vos nombreux essais. J'arrête là, surtout à cause de ce genre de réponse, bien que j'ai pris la peine d'expliquer ma difficulté à de très nombreuses reprises.

Bonne journée!

 

[RyuAutodidacte]

Bonjour @Lagertha ,

Bonjour @RyuAutodidacte , merci pour ce fichier.

La bonne nouvelle c'est que tout se déroule sans faire planter Excel.

Ensuite, et ce n'est qu'une remarque, je n'ai pas été très claire, je le regrette, mais le conflit est pile dans la situation inverse: mot en commun = conflit, mais finalement, ce n'est qu'une inversion des termes.

Je suppose donc que vous avez modifié le code comme ceci :

Option Explicit

Sub FindWords()

Dim Wd As New Collection, VA, LRowB As Integer, V, x As Long, y As Integer, L As String, T!
    
    T = Timer
    
    VA = ActiveSheet.Cells(1).CurrentRegion.Value
    LRowB = Application.CountA(ActiveSheet.Cells(1).CurrentRegion.Offset(, 1).Resize(, 1))
    
    For x = 2 To UBound(VA)
        V = Split(Application.Trim(VA(x, 1)))
        L = "RISQUE DE CONFLIT - CLIENT NOK"
        For y = LBound(V) To UBound(V)
            On Error Resume Next
            Wd.Add L, V(y)
            If Err Then Err.Clear
        Next
    Next
    
    For x = 2 To LRowB
        V = Split(Application.Trim(VA(x, 2)))
        L = ""
        For y = LBound(V) To UBound(V)
            On Error Resume Next
                L = Wd(V(y))
            If Err Then Err.Clear
        Next
        If Len(L) = 0 Then L = "CLIENT "
        VA(x, 3) = L
    Next
    
    VA = Application.Index(VA, Application.Evaluate("Row(" & 2 & ":" & LRowB & ")"), 3)
    
Application.ScreenUpdating = False
    ActiveSheet.Cells(2, 3).Resize(UBound(VA), 1).Value = VA
Application.ScreenUpdating = True
    
    MsgBox Format(Timer - T, "0.0000s")
    
End Sub

Merci à tout le monde pour ce travail et vos nombreux essais. J'arrête là, surtout à cause de ce genre de réponse, bien que j'ai pris la peine d'expliquer ma difficulté à de très nombreuses reprises.

- Je pense que c'était pas aussi claire pour tout le monde à commencer par moi puisque j'ai fait une inversion (le "ok" dans le fichier exemple peut porter à confusion)
- Les bénévoles donnant de l'aide sur le forum savent par expérience, que les demandeurs (parfois),
manquent de précisions/de clarté dans les explications, ou ne voient pas certaines problématiques qui pourrait survenir.
- Donc il est normal de prévenir les demandeurs de problématiques qu'ils pourraient rencontrés comme l'a fait @Cousinhub (et d'autres …) …
- Cela permet de préciser et d'ajuster la teneur du problème dans le post (dans le cas de manque de précisions … ou d'une mauvaises compréhension de la demande …)

J'arrête là, surtout à cause de ce genre de réponse

- Donc le fait de vouloir prévenir le demandeur, moi j'appelle cela plutôt de la Bienveillance !

PS : si vous avez votre solution dans ce fil de discussion (idem dans les futur demandes), il serait bien d'indiquer laquelle en la cochant … (c'est pas une obligation) mais cela aiderait d'autres personnes
faisant une recherche sur un problème similaire … il pourrait alors se référer directement à la solution !

Bonne journée
Ryu

 

[Cousinhub]

Re-,
J'hésitais avant de répondre, afin de ne froisser personne, surtout pas la demandeuse...
Mais quand je vois ceci, et qui plus est, avec un fichier un peu plus réaliste, comment dire????
Navré, dégoûté, c'est à ne plus avoir envie d'aider...

 

[Staple1600]

Bonjour le fil

@Cousinhub
Ouvre la fenêtre
Pardon ouvre ton PQ, et ca ira tout de suite mieux.

Lagertha ne fait pas les choses à moitié
Elle est devenue Guest !!!
(Donc suppression de son compte)

Faut espérer que tout le jus de crane qu'on peut lire servira à un nouveau membre moins irascible ou un un vieux membre (comme moi) pour ses soirées poésies VBA au coin du feu.

(Pardon ...au coin de la chaudière à granulés à condensation, même si c'est moins glam )

 

[Cousinhub]

Bonjour le fil

@Cousinhub
Ouvre la fenêtre
Pardon ouvre ton PQ, et ca ira tout de suite mieux.

Lagertha ne fait pas les choses à moitié
Elle est devenue Guest !!!
(Donc suppression de son compte)

Faut espérer que tout le jus de crane qu'on peut lire servira à un nouveau membre moins irascible ou un un vieux membre (comme moi) pour ses soirées poésies VBA au coin du feu.

(Pardon ...au coin de la chaudière à granulés à condensation, même si c'est moins glam )

Hi,
Ben oui, d'autant que mon résultat PQ était prêt...
Et une quinzaine de secondes pour 22 000 lignes à scanner avec une colonne d'une cinquantaine de lignes...
Bah, le beurre, l'argent du beurre.... (je m'arrêterai là...)
Bonne soirée

 

[Staple1600]

Re

@Cousinhub
Malheureux! Ne me parle pas de beurre !
C'est cadeau !
(Par contre, ca te prendra plus de 15 secondes )

Enjoy

PS: Désolé pour la pub, qu'il faut se fader avant