[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

4 réponses

  1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour,

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

    dans ce que tu veux, on ne travaillerait plus que sur 1 seule cellule ?
    0
  2. 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
    1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      OK, je regarde mais soit patient
      0
    2. Mirage
       
      ok merci :)
      0
  3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    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
  4. Mirage
     
    Merci beaucoup, ça fonctionne comme je l'espérais !
    Je te tiens au courant si j'ai un souci avec :)
    0
    1. 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
    2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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
    3. Mirage
       
      ok, ça marche maintenant !

      Un grand merci à toi :)
      0