Ressortir un mot à partir d'un liste

Bonjour,

J'ai besoin d'un coup de main sur la macro ci dessous. Qui fonctionne mais est terriblement longue.

J'ai une liste de mot dans l'onglet "Conso' en colonne A

J'ai environ 500 ligne contenant une description sur la feuille 2 en colonne C. Il faut que je passe sur chaque ligne pour chercher si un mot de ma liste apparaît dans le champ description. Si oui j'indique le mot dans la feuille 2 colonne AI.

La macro a été déposée sur la feuille 2.

Pouvez vous m'aider à la rendre plus efficace.

Sub Cherche()
Dim Cel As Range
Dim Depart As String
Dim J As Long
Dim Colonne As Integer

  For J = 1 To Sheets("Conso").Range("A" & Rows.Count).End(xlUp).Row
    Set Cel = Columns("C").Find(what:=Sheets("Conso").Range("A" & J), LookIn:=xlValues, lookat:=xlPart)
    If Not Cel Is Nothing Then
      Colonne = 35
      Depart = Cel.Address
      Do
        Cells(Cel.Row, Colonne) = Sheets("Conso").Range("A" & J)
        Set Cel = Columns("C").FindNext(Cel)
      Loop While Not Cel Is Nothing And Depart <> Cel.Address
    End If
  Next J
End Sub

D'avance merci.

Bonjour

ssan a écrit :

La macro a été déposée sur la feuille 2.

Je ne vois pas plus de feuille 2 que de fichier joint...

Bye !

Désolé.

Voici le fichier en pièce jointe.

Encore merci de votre aide

gmb a écrit :

Bonjour

ssan a écrit :

La macro a été déposée sur la feuille 2.

Je ne vois pas plus de feuille 2 que de fichier joint...

Bye !

Désolé.

La voici en pièce jointe

Bonjour,

Ci-joint une proposition à tester.

Code plus long, traitement plus rapide.

Gère plusieurs mots (si un seul mot à gérer, possible d'accélérer en sortant de la boucle)

Bonne journée

Bouben

ssan a écrit :

Bonjour,

J'ai besoin d'un coup de main sur la macro ci dessous. Qui fonctionne mais est terriblement longue.

[/code]

D'avance merci.

Bonjour,

qu'entends tu par terriblement longue ?

P.

Bonjour,

Quand je lance la macro elle tourne pendant 3 à 4 minutes. Je me demande si ce n'est pas à cause du nombre de caractère présent dans les cellules où le mot est recherché.

Je suis en train de tester la macro de bouben (merci bcp). Mais j'ai l'impression que ça va ramer également.

D'avance merci.

ssan a écrit :

Bonjour,

Quand je lance la macro elle tourne pendant 3 à 4 minutes. Je me demande si ce n'est pas à cause du nombre de caractère présent dans les cellules où le mot est recherché.

Je suis en train de tester la macro de bouben (merci bcp). Mais j'ai l'impression que ça va ramer également.

D'avance merci.

Bizarre.... un rien de modif dans ton code et recherche de 4 mots dans 650 lignes : 0.0468

Dell 24 Gg Ram / 4.00 GgHz / Win10 / Excel2007

Euh là je vais passer pour un super gros nul mais quelle modif as tu fait ?

ssan a écrit :

Euh là je vais passer pour un super gros nul mais quelle modif as tu fait ?

Pas du tout...

voilà ce que j'ai fais comme changement et il doit y avoir mieux

Option Explicit
Sub Cherche()
Dim Cel As Range
Dim Depart As String
Dim J As Long
Dim Colonne As Integer
Dim a
Dim i
Dim t
t = Timer
a = Array("tag", "sad", "test", "essai")
For i = 0 To UBound(a)
  Set Cel = Columns("C").Find(a(i), LookIn:=xlValues, lookat:=xlPart)
  If Not Cel Is Nothing Then
    Colonne = 35
    Depart = Cel.Address
    Do
      Cells(Cel.Row, Colonne) = a(i)
      Set Cel = Columns("C").FindNext(Cel)
    Loop While Not Cel Is Nothing And Depart <> Cel.Address
  End If
Next i
MsgBox (Timer - t)
End Sub

Bonjour à tous.

Un double essai à tester.

Bye !

gmb a écrit :

Bonjour à tous.

Un double essai à tester.

Bye !

Je me disais bien qu'il y avait mieux.... surtout si bcp de lignes et/ou pc lent

Merci à tous, vos solution sont nickel et sa tourne bcp mieux.

Merci gmb pour la macro supplémentaire