[Excel] Recherche multiple dans une cellule

Résolu
Mirage -  
 Mirage -
Bonjour,

Je fait suite à un premier post qui consistait en l'extraction d'une donnée recherché dans une cellule.

Cependant, j'aimerai savoir si on pouvais adapter la macro, à la recherche de plusieurs textes (supérieur à 2 si possible)

Je vous joint le fichier avec la macro précédente.

J'espère que vous trouverez la solution.

Merci

https://www.cjoint.com/?BDciSKjSuGU
A voir également:

4 réponses

michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Bonjour,

Ça me rajeunit un peu cette macro ! :o)

dans ce que tu veux, on ne travaillerait plus que sur 1 seule cellule ?
0
Mirage
 
Alors, oui en fait on a toujours une seule cellule "source", par contre on a plusieurs cellules de sorties. (autant de cellule que de modèles trouvés).

Voila :)
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
OK, je regarde mais soit patient
0
Mirage
 
ok merci :)
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Re,

la macro extrait les N mots de la sélection de la cellule active
Option Explicit

Sub extraire_mots()
Dim Col As Integer, Lig As Long, Texto As String
Dim T_mots(), derlig As Byte, cptr As Byte

'Initialisations
Application.ScreenUpdating = False
With ActiveCell
     texto = UCase(ActiveCell)
     Col = .Column + 1
     Lig = .Row
End With
Range(Cells(Lig, Col), Cells(Lig + 10, Col)).Clear

'collecte des mots sélectionnés
With Sheets("param")
     derlig = .Range("B250").End(xlUp).Row
     T_mots = Application.Transpose(.Range("B2:B" & derlig).Value)
     
End With

'extraction des mots
For cptr = 1 To UBound(T_mots)
     If texto Like "*" & UCase(T_mots(cptr)) & "*" Then
          With Cells(Lig, Col)
               .Value = T_mots(cptr)
               .Borders.Weight = xlThin
          End With
          Lig = Lig + 1
     End If
Next

End Sub
0
Mirage
 
Merci beaucoup, ça fonctionne comme je l'espérais !
Je te tiens au courant si j'ai un souci avec :)
0
Mirage
 
Après quelques temps d'utilisation, je viens de constater que la macro plante si l'onglet param dépasse les 256 modèles. J'ai tenté d'augmenter le nombre max de valeurs dans la macro:

derlig = .Range("B250").End(xlUp).Row > passage à 260 par exemple

mais ça ne fonctionne pas. Y a t-il un autre paramètre à changer? :)
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Il faut simplement modifier les types des variables
Dim Col As Integer, Lig As Long, Texto As String 
Dim T_mots(), derlig As Integer, cptr As Integer 
 
'Initialisations 
Application.ScreenUpdating = False 
With ActiveCell 
     Texto = UCase(ActiveCell) 
     Col = .Column + 1 
     Lig = .Row 
End With 
Range(Cells(Lig, Col), Cells(Lig + 10, Col)).Clear 

'collecte des mots sélectionnés 
With Sheets("param") 
     derlig = .Range("B10000").End(xlUp).Row


en espèrant que...
0
Mirage
 
ok, ça marche maintenant !

Un grand merci à toi :)
0