Recherche de texte dans un autre texte

Bonjour,

je viens de lire plusieurs posts à ce sujet mais je ne trouve pas de solution adaptée à mon problème.

J'ai dans une colonne une liste de libellés qui contiennent chacun des noms des numéros et qui sont saisis à la main et donc non standardisés.

Exemple de la colonne:

NF DUPONT 91256522

9588444 JEAN AR NF

etc..

j'ai par ailleurs liste exhaustive de tous les noms :

DUPONT

JEAN

etc...

je voudrais pouvoir extraire de la 1ère liste uniquement le nom en me basant sur la liste de noms.

Je bute complètement...

Vous pouriez svp m'aider ?

je cherche une solution en VBA si possible pour l'inclure dans une autre macro.

Merci d'avance,

Cdt,

Alci

Bonjour

Si tu joignais ton fichier, il serait plus facile de te proposer quelque chose.

Bye !

Bien sûr ! le voici

pour info, le fichier de travail contient 25 000 lignes et 200 noms...

Merci !

Alcibiade

Bonjour

qq infos complémentaires

a quoi correspondent ces numéros, le contenu des cellules est -il exhaustif?

Merci

FINDRH

ce sont des n° de saisie dans un ERP, des références, etc..

le format peut changer, rien n'est fixe (ça dépend de la personne qui saisit ce texte).

La seule façon d'extraire un nom, c'est de le retrouver dans l'autre liste...

Bonjour

je regarde cela à tète reposée, j'ai une solution pour les noms uniques....mais pas pour des noms qui se répètent !!!

Il y aura surement qq d'autre qui te répondra !

Cordialement

FINDRH

Bonjour à tous

alcibiade a écrit :

pour info, le fichier de travail contient 25 000 lignes et 200 noms...

Et tu ne nous en laisses que 3 lignes et 4 noms : c'est vraiment minimaliste.

Ne pourrais-tu pas en donner davantage avec en particulier un florilège de noms : ce serait plus pratique pour faire des essais.

Bye !

Merci

j'ai trouvé ça entre temps et ça fonctionne plutôt pas mal :

Private Sub CommandButton1_Click()

' Feuil5 :la feuille avec les noms

' Feuil3 :la feuille avec les données qui contiennent les noms

Application.ScreenUpdating = False

Dim Mat(), NbLignes As Integer, i As Integer, Ref As Range, c As Range

NbLignes = Feuil3.UsedRange.Rows.Count

ReDim Mat(NbLignes)

With Feuil5.Range("A1")

For i = 0 To NbLignes - 1

Mat(i) = .Offset(i)

Next

End With

With Sheets(3)

Set Ref = Intersect(.UsedRange, .Range("B:B"))

End With

Set Ref = Intersect(Ref, Ref.Offset(1))

For Each c In Ref

For i = 0 To NbLignes - 1

If Len(Replace(c, Mat(i), "")) <> Len(c) Then

c.Offset(0, 1) = Mat(i)

Exit For

End If

Next i

Next c

Application.ScreenUpdating = True

End Sub

Bonjour,

Une proposition sous réserve de la représentativité du modèle :

Sub ExtraireNoms()
    Dim n%, i%, j%, ln%, nom As Range, nt As Range, dn
    With Worksheets("Noms")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set nom = .Range("A2:A" & n)
    End With
    With nom
        ln = Len(.Cells(1, 1).Value)
        For i = 2 To .Rows.Count
            If Len(.Cells(i, 1)) < ln Then ln = Len(.Cells(i, 1).Value)
        Next i
    End With
    With Worksheets("Données")
        n = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 2 To n
            dn = Split(.Cells(i, 3).Value)
            For j = 0 To UBound(dn)
                If Val(dn(j)) = 0 And Len(dn(j)) >= ln Then
                    Set nt = nom.Find(dn(j), , xlValues, xlWhole)
                    If Not nt Is Nothing Then
                        .Cells(i, 4).Value = dn(j)
                        Exit For
                    End If
                End If
            Next j
            If j > UBound(dn) Then .Cells(i, 4).Value = "Divers"
        Next i
    End With
End Sub

Cordialement

Tu as aussi cela :

Sub ListeDesNoms()

    Set fn = Sheets("Noms")
    Set fd = Sheets("Données")
    tDonnées = fd.Range("C2:C" & fd.Range("C" & Rows.Count).End(xlUp).Row)
    tNoms = fn.Range("A2:A" & fn.Range("A" & Rows.Count).End(xlUp).Row)
    fd.Range("D2:D" & fd.Range("D" & Rows.Count).End(xlUp).Row).Clear
    tN = fd.Range("D2:D" & fd.Range("C" & Rows.Count).End(xlUp).Row)
    For ln = 1 To UBound(tDonnées, 1) - 1
        For i = 1 To UBound(tNoms, 1) - 1
            If tDonnées(ln, 1) Like "*" & tNoms(i, 1) & "*" Then
                tN(ln, 1) = tNoms(i, 1)
            End If
        Next i
        If tN(ln, 1) = "" Then
            tN(ln, 1) = "Divers"
        End If
    Next ln
    Range("D2").Resize(UBound(tDonnées, 1), 1) = tN
End Sub

Dommage qu'on ne puisse pas le tester en vrai grandeur...

Bye !

Bonjour,

Je vais étudier vos propositions aujourd'hui.

Merci beaucoup !

Alci