Macro rechercher liste de valeurs texte dans une colonne

Bonjour tout le monde,

SVP, je cherche une solution à mon souci et jusqu'à aujourd'hui je n'ai pas trouver de solution qui s'adapte à mon besoin. Alors j’espère trouver l'aide dont j'ai besoin ici.

Pour faire simple, j'ai un classeur Excel qui contient deux onglets :

Onglet_01 (Colonne A) ► Liste de prénoms.

Onglet_02 : noms & prénoms, n° de tel, adresse, cp.

J'ai besoin de chercher chaque prénom de la liste des prénoms de l'onglet_01 (Colonne A) dans l'onglet_02 (noms & prénoms) sachant que la valeur cherchée peut se trouver dans n'importe quelle position de la cellule de l'onglet_02 de la colonne A (au début, au milieu ou à la fin).

Le principe est similaire à la manipulation CTRL+F sauf que la recherche doit se faire une liste contenant plus que 100 000 prénoms.

Le résultats doit être lisible (marquer la ligne où le résultat a été trouver en insérant une valeur devant la première cellule vide de la ligne.

Je ne sais pas si mes explications sont assez claires mais je joint quand même un exemple de mon fichier pour faciliter la compréhension de ma demande.

J'ai essayer avec la fonction Index équivalent sauf que ça me prends beaucoup de temps lors du calcul automatique et le volume du fichier s'accroit et ça me crée des lenteurs énormes sur mon poste de travail.

=INDEX(Onglet_01!$A:$A;EQUIV("*"&$A2&"*";Onglet_01!$A:$A;0))

J'ai aussi trouver un code VBA sur le net sauf que ça ne m'aide pas beaucoup car elle me renvoi un résultat inexacte :

Sub Reperer_Ch_01()

'Place un 0 en face de chaque cellule à tester

y = Range("C" & Rows.Count).End(xlUp).Row 'y = le nombre de cellules non-vides de la colonne C

Range("I2:I" & y).Value = "" 'Place un 0 en face de chaque cellule non-vide de la colonne C (en colonne I)

'Teste la présence des chaines de caractère de la colonne A sur chaque cellule non-vide de la colonne B

For x = 2 To Range("A" & Rows.Count).End(xlUp).Row 'nombre de cellules contenant les chaines de caractères à rechercher

entité = Range("A" & x) 'on recherche la première chaine de caractères, ici en A2

Set c = ActiveSheet.Columns(4).Find(entité, LookIn:=xlValues, lookat:=xlPart) '"c" représente la cellule où est trouvée la chaine de caractères

If Not c Is Nothing Then

firstAddress = c.Address

Do

c.Offset(0, 5).Value = 1 'placer un "1" en face de la cellule qui contient la chaine de caractères recherchée

Set c = ActiveSheet.Columns(4).FindNext(c)

Loop While Not c Is Nothing And c.Address <> firstAddress

End If

Next x 'passe à la deuxième chaine de caractères recherchée (donc passe à la chaine de caractères en A3, puis en A4, etc...)

End Sub

Je vous remercie d'avance pour votre aide.

Salut mklabidi !

Est-ce qu'un simple nb.si t'irait ?

Fichier joint

Bonjour Gaz0line,

Tout d'abord, merci pour cette réponse mais le truc c'est que la fonction nb.si va me bouffer beaucoup de mémoire et la taille du fichier va augmenter c'est pour ça que j'ai opter pour une solution en VBA et non une fonction. Mon fichier peut atteindre les 200 000 lignes en plus j'ai besoin que la recherche s’effectue sur le texte exacte :

Exemple : quand je cherche Adolf ça me renvoi uniquement vers les lignes ou se trouve le texte Adlof et non pas vers les lignes ou les caractères Ado se trouvent.

Bonjour , une routine toute simple pour la recherche exact :

Sub r()
  Dim a, b
  Dim i%, j%
  a = Feuil1.UsedRange
  b = Feuil2.UsedRange
  With Feuil2
    For i = 2 To .UsedRange.Rows.Count
      For j = 2 To UBound(a)
        If UCase(b(i, 2)) = UCase(a(j, 1)) Then
          Range(.Cells(i, 1), .Cells(i, 6)).Interior.ColorIndex = 3
        End If
      Next j
    Next i
  End With
End Sub

Sinon pour la recherche d'une équivalence partout dans la cellule

Sub r()
  Dim a, b
  Dim i%, j%
  a = Feuil1.UsedRange
  b = Feuil2.UsedRange
  With Feuil2
    For i = 2 To .UsedRange.Rows.Count
      For j = 2 To UBound(a)
        If InStr(1, UCase(a(j, 1)), UCase(b(i, 2)), vbTextCompare) >= 1 Then
          Range(.Cells(i, 1), .Cells(i, 6)).Interior.ColorIndex = 3
        End If
      Next j
    Next i
  End With
End Sub

Bonjour Machin,

Merci pour votre aide.

J'ai tester les deux codes. Le premier ne fait rien par contre le deuxième fonctionne, et il s’avère que j'ai justement besoin du premier pour la recherche exacte.

Pourtant ton explication suggérait que c'est le deuxième code qui correspondait.

Exemple avec "Ado" en ligne 12, onglet 2 :

Le 2ème code cherche "Ado" dans l'onglet 1 et trouve un résultat avec Adolf, puisque Adolf contient Ado.

Le 1er code ne peut pas marcher puisque le terme exact "Ado" n'existe pas dans l'onglet 1.

Il existe Adolf, qui est bien trouvé par le 2ème code.

Si tu ajoutes "Ado" dans l'onglet 1 tu verras que le code 1 marche, puisqu'il cherche exactement et uniquement "Ado"

C'est parfait,

J'ai tester et ça marche avec le premier code. Ce qu'il faut c'est que je dois alimenter ma liste de prénoms au fur et à mesure pour avoir tous les prénoms que je dois distinguer.

Par contre serait-il possible de modifier le résultats? Au lieu d'avoir la ligne en rouge j'aimerai bien qu'il m'affiche une valeur "1" ou "X" devant la première cellule vide de cette ligne (Colonne G).

"placer un "1" en face de la cellule qui contient le valeur trouvée"

Dans le 1er code , remplace

 
If UCase(b(i, 2)) = UCase(a(j, 1)) Then
     Range(.Cells(i, 1), .Cells(i, 6)).Interior.ColorIndex = 3
End If

par

If UCase(b(i, 2)) = UCase(a(j, 1)) Then
      Cells(i, Cells(i, Cells.Columns.Count).End(xlToLeft).Column + 1).Value = 1
End If

( Machin je me suis permise de répondre à ta place, j'espère que tu ne m'en veux pas ! )

Euh... gazoline... Non aucun souci , l'important c'est que nous ayons pu répondre au besoin du M'sieur

J'ai fait ce ci :

If UCase(b(i, 2)) = UCase(a(j, 1)) Then

Range(.Cells(i, 6), .Cells(i, 6)).Offset(0, 1).Value = 1

Gaz0line et Machin, je vous remercie beaucoup pour votre aide et votre patience. Vous me sauvez la vie.

Merci infiniment.

Attention mklabidi : "offset" va remplir la cellule qui est à côté de la colonne F, que cette cellule soit vide ou pas.

Autrement dit : si tu veux agrandir ton tableau et mettre une donnée en colonne G, ton "offset" écrasera la donnée qui s'y trouve.

Mon code cherche la 1ère cellule vide en bout de ligne.

Comme ça si tu ajoutes des colonnes, ton 1 se mettra au bout, quel que soit le nombre de colonnes.

Mais si tu veux conserver ton code, tu peux le réduire :

au lieu de

Range(.Cells(i, 6), .Cells(i, 6)).Offset(0, 1).Value = 1

écris juste :

Cells(i, 6).Offset(0, 1).Value = 1

Machin a écrit :

Euh... gazoline... Non aucun souci , l'important c'est que nous ayons pu répondre au besoin du M'sieur

Bah oui mais bon, tu aurais pu te dire "de quoi elle se mêle"

"Bah oui mais bon, tu aurais pu te dire "de quoi elle se mêle" "

Oui c'est vrai d'ailleurs !

mklabidi, alors où en ête vous avec le code ?

Bonjour,

je vais tester et voir le résultat.

Excusez-moi pour le dérangement, il semblerait que le code plante, j'ai message d'erreur quand j’exécute la macro :

Erreur d’exécution '6' :

Dépassement de capacité

Pouvez-vous m'aider SVP?

Essayez de changer les

  Dim i%, j%

en

  Dim i&, j&

Et si le problème persiste fournissez un fichier car de là où nous somme nous avons un peu de mal pour voir votre fichier...

Bonjour,

J'ai changer le code en :

Dim a, b

Dim i As Long

Dim j As Long

a = Feuil1.UsedRange

b = Feuil2.UsedRange

With Feuil2

For i = 2 To .UsedRange.Rows.Count

For j = 2 To UBound(a)

If UCase(b(i, 2)) = UCase(a(j, 1)) Then

Cells(i, 6).Offset(0, 1).Value = 1

End If

Next j

Next i

End With

End Sub

Bonjour Oui et ?

ça marche, j'ai juste un petit ralentissement et Excel m'affiche (ne réponds pas) au début mais ça fonctionne si je ne touche à rien et que je laisse tourner.

Je vais essayer de faire d'une autre façon pour gagner en rapidité mais je ne garantit rien

Merci, sinon y a pas de souci tant que ça fonctionne et que le résultat est bon ça ne pose pas de problème.