Comparer texte entre deux cellules

Zimae

XLDnaute Nouveau
Bonjour,

J'ai un fichier avec une colonne, qui a des cellules en données textes (toutes différentes). (que j'appelerai colonne B)
J'ai une plage avec d'autres cellules en format texte. (colonne A)
Je sais que certains mots sont en commun dans les deux colonnes, et j'ai besoin de savoir dans quelles cellules de la colonne A j'ai des mots qui sont dans les cellules de la colonne B.
Est-ce qu'il existe une formule (ou plusieurs pour y aboutir) pour ça?
Ou Est-ce que je dois plutôt passer par du VBA?


Merci d'avance et bonne journée!

Fanny
 

Zimae

XLDnaute Nouveau
Re : Comparer texte entre deux cellules

Bonjour,

Merci pour votre réponse rapide.
Mon problème est que les plages de données ne sont pas identiques. Je peux par exemple avoir dans le colonne B "Abc holding corporation" et dans le colonne A "clinique vétérinaire ABC". Je souhaite que ma formule "flague" le "dénominateur commun", soit "ABC". Merci!
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Comparer texte entre deux cellules

Voir PJ

Code:
Function Proche(DemClient, cata As Range)
  Set dMotsCat = CreateObject("Scripting.Dictionary")
  Set dref = CreateObject("Scripting.Dictionary")
  i = 1
  For Each c In cata
    dref(CStr(i)) = c.Value
    For Each m In Split(Trim(c.Value), " ")
      dMotsCat(sansAccent(LCase(m))) = dMotsCat(sansAccent(LCase(m))) & CStr(i) & " "
    Next m
    i = i + 1
  Next c
  DemClient = sansAccent(SansPoint(LCase(DemClient)))
  Set dDemClient = CreateObject("Scripting.Dictionary")
  For Each m In Split(DemClient, " ")
    tem = False
    For Each i In dMotsCat.keys
      If i Like m & "*" Then
        tem = True
        Exit For
      End If
    Next i
     If tem Then
      For Each ref In Split(Trim(dMotsCat(i)), " ")
        dDemClient(ref) = dDemClient(ref) + 1
      Next ref
    End If
  Next m
  '-- recherche maxi dans dDemClient
  If dDemClient.Count > 0 Then
   Maxi = Application.Max(dDemClient.items)
   MeilNotePourc = 0
   For Each ref In dDemClient.keys
     If dDemClient(ref) = Maxi Then
        notePourc = Maxi / (UBound(Split(dref(ref), " ")) + 1)
        If notePourc > MeilNotePourc Then
           MeilNotePourc = notePourc
           RefMeilNote = ref
           meilNote = Maxi & "/" & (UBound(Split(Trim(dref(ref)), " ")) + 1)
        End If
     End If
   Next ref
   Proche = dref(RefMeilNote) '& " [" & meilNote & "]"
  Else
   Proche = ""
  End If
End Function

Function SansPoint(chaine)
  a = Split(chaine, " ")
  For i = LBound(a) To UBound(a)
    If Right(a(i), 1) = "." Then a(i) = Left(a(i), Len(a(i)) - 1)
  Next i
  SansPoint = Join(a, " ")
End Function

Function sansAccent(chaine)
   codeA = "ÉÈÊËÔéèêëàçùôûïî"
   codeB = "EEEEOeeeeacuouii"
   temp = chaine
   For i = 1 To Len(temp)
    p = InStr(codeA, Mid(temp, i, 1))
    If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1)
   Next
   sansAccent = temp
End Function

JB
 

Pièces jointes

  • Proches2zz.xls
    41 KB · Affichages: 49
Dernière édition:

Zimae

XLDnaute Nouveau
Re : Comparer texte entre deux cellules

Bonjour,

Voici ce que ça me fait quand je fais votre formule (Colonne G).

Pourquoi ça ne fonctionne pas?

Merci et bonne journée!
 

Pièces jointes

  • Recherche formule.xlsx
    10.5 KB · Affichages: 28
  • Recherche formule.xlsx
    10.5 KB · Affichages: 37
  • Recherche formule.xlsx
    10.5 KB · Affichages: 37

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Comparer texte entre deux cellules

Voir PJ

Alt+F11
Insertion/Module

Sélectionner C2:G2
=prochemult(A2;Feuil2!$A$2:$A$100)
valider avec maj+ctrl+entrée

Code:
Function ProcheMult(DemClient, cata As Range)
  Set dMotsCat = CreateObject("Scripting.Dictionary")
  Set dref = CreateObject("Scripting.Dictionary")
  i = 1
  a = cata
  For Each c In a
    dref(CStr(i)) = c
    For Each m In Split(Application.Trim(c), " ")
     dMotsCat(sansAccent(LCase(m))) = dMotsCat(sansAccent(LCase(m))) & CStr(i) & " "
    Next m
    i = i + 1
  Next c
  DemClient = sansAccent(LCase(DemClient))
  Set dDemClient = CreateObject("Scripting.Dictionary")
  For Each m In Split(DemClient, " ")
    If dMotsCat.exists(m) Then
      For Each ref In Split(Application.Trim(dMotsCat(m)), " ")
        dDemClient(ref) = dDemClient(ref) + 1
      Next ref
    End If
  Next m
  '-- recherche proches
  If dDemClient.Count > 0 Then
   Dim temp()
   ncol = Application.Caller.Columns.Count
   ReDim temp(1 To ncol)
   i = 1
   For Each c In dDemClient.keys
     temp(i) = dref(c)
     i = i + 1: If i > ncol Then Exit For
   Next c
   ProcheMult = temp
  Else
   ProcheMult = ""
  End If
End Function

JB
 

Pièces jointes

  • Recherche formule.xls
    50 KB · Affichages: 42
  • Recherche formule.xls
    50 KB · Affichages: 41
  • Recherche formule.xls
    50 KB · Affichages: 45
Dernière édition:

Zimae

XLDnaute Nouveau
Re : Comparer texte entre deux cellules

Merci!

Je ne connais absolument pas le VBA, qu'Est-ce que je dois faire avec le code que vous me copiez dans le message?
Est-ce que je dois le copier quelque part dans mon fichier? Est-ce que ça a un lien avec les accolades en avant et en arrière de votre formule?

Il ne me manque pas grand chose pour que ça fonctionne dans mon fichier final, merci beaucoup pour votre aide!


Edit: je viens de comprendre comment l'utiliser merci :)
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla