RechercheV si une partie de texte identique entre 2 cellules

Bonjour à tous,

je viens chercher de l'aide afin d'analyser un certain nombre de données et je commence à perdre espoir.

Je dispose de deux fichier excel avec un certain nombre de données (+ de 2500 lignes):

1er fichier:

• Colonne A = Nom de l'entreprise
• Colonne B = Adresse
• Colonne C = SIRET

2eme fichier:

• Cell A = Nom de l'entreprise
• Cell B = Adresse
• Cell C = Telephone

Mon problème est que mes deux fichiers ne proviennent pas de la même source et n'ont pas le même format de texte, je m'explique:

Dans le 1er fichier, je vais avoir un nom d'entreprise = Dumas maconnerie et une Adresse = 1 rue de la rotonde.

Dans mon second fichier je vais avoir pour la même entreprise = Dumas Gilles et une Adresse = 1r rotonde.

Mon objectif est d'intégrer les numeros du deuxième fichier dans la colonne D du fichier 1 des entreprises correspondantes. Je recherche une formule qui recherche si la cellule A1 contient une partie des cellule en ColonneA (fichier 2) et si cellule A1 contient une partie des cellule en ColonneB (fichier 2), alors D1 = ColonneC (fichier2).

J'espère que mes explications seront assez clair et qu'il existe une solution.

Merci d'avance pour votre aide.

Salut Vincent,

L'exemple que je te propose ici fonctionne mais je doute fort, sans tes fichiers qui doivent foisonner d'exceptions, qu'il en soit de même chez toi.

Pas de fioritures : seuls les deux fichiers concernés doivent être ouverts, le code devant être collé dans le fichier devant contenir la correction (n° tél) et ce fichier enregistré en .XLSM.

Le code s'attend à trouver les infos en Sheets(1) à partir de [A1].

Un double-clic en 'Vincent-A' [A1] démarre la macro.

A tester et sûrement à adapter.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim sWKB As Workbook
Dim tTab1, tTab2, tSplit, iFlag%
'
If Not Intersect(Target, [A1]) Is Nothing Then
    Cancel = True
    tTab1 = Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).Value
    For Each sWKB In Workbooks
        If sWKB.Name <> ThisWorkbook.Name Then
            With sWKB.Sheets(1)
                tTab2 = .Range("A1:C" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
            End With
            For x = 1 To UBound(tTab1, 1)
                For y = 1 To UBound(tTab2, 1)
                    iFlag = 0
                    For w = 1 To 2
                        tSplit = IIf(w = 1, Split(tTab2(y, 1), " "), Split(tTab2(y, 2), " "))
                        For Z = 0 To UBound(tSplit)
                            If Not IsNumeric(tSplit(Z)) And Len(tSplit(Z)) > 2 And InStr(UCase(tTab1(x, IIf(w = 1, 1, 2))), UCase(tSplit(Z))) > 0 Then iFlag = iFlag + IIf(w = 1, 10, 1)
                        Next
                    Next
                    If iFlag >= 11 Then
                        tTab1(x, 4) = tTab2(y, 3)
                        Exit For
                    End If
                Next
            Next
            Range("A1").Resize(UBound(tTab1, 1), 4).Value = tTab1
            Exit For
        End If
    Next
End If
'
End Sub

A+