Exel extraction verticale ciblée

bonjour à tous,
je souhaite avoir de l'aide sur un sujet que je n'arrive par à resoudre

j'ai créé un tableau sur exel d'une centaine de lignes et d'environ 10 colonnes
dans les cellules d'une colonne, j'ai marqué differentes initiales de personne (2à3 lettres) séparés par des virgules. cela donne: " bv, dg, jk, hy, re, ty, kl, ....". mais toutes les cellules de cette colonne ne contienne pas les meme initiale (en lettre et en nombre)

dans un feuille séparé, je souhaite que Exel recherche verticalement dans la colonne des intiales, les cellules qui contiennent par exemple les initiales RE et me donne le contenu des cellules qui sont sur la meme ligne

est ce possible? comment le faire?
dans l'attente de vous lire
merci d'avance

4 réponses

  1. Bonjour boris 07,

    Je ne pense pas qu'Excel sache faire ça. Ça nécessite une analyse des chaînes de caractères.
    Evidemment, on peut écrire quelque chose en VBA, mais ce genre de truc sur les chaînes, sans être compliqué, n'est pas franchement passionnant...

    Avant d'en passer par là, il faut se demander si la structure choisie pour les données est la plus adaptée. Déjà d'abord...
    0
    1. Hello boris 07,

      Réflexion faite, je t'ai fait une petite macro qui devrait faire ce que tu veux.
      Il te suffit d'adapter quelques paramètres, dans les lignes comprises entre les lignes "======" :
      - le nom de la feuille où se trouvent tes initiales
      - le nom de la feuille résultat
      - le n° de la première ligne détail de la feuille à analyser (après les lignes d'entête)
      - et idem pour la feuille résultat
      - le n° de la colonne où se trouvent les initiales (A=1, B=2, etc.)

      Si tu ne connais pas trop VBA, pour installer cette macro :
      - dans Excel, fais : Outils / Macro / Visual Basic Editor
      - Insertion / Module
      Dans le cadre à droite, copie la macro. C'est tout.

      Pour la lancer :
      - Soit tu fais :
      Outils / Macro / Macros...
      Sélectionner la macro, et bouton Exécuter

      Soit tu te crées un appel par touche :
      - Outils / Macro / Macros...
      - Sélectionner la macro, puis bouton Options...
      - Touche de raccourci : taper une lettre majuscule (M comme macro, par exemple)
      Ensuite, pour lancer la macro, il te suffit de faire CTRL+MAJ+M

      Voici la macro :
      Sub Filtre()
      
        Dim I       As Integer    ' pour recherche à l'intérieur de la chaine
        Dim I_Orig  As Long       ' première ligne à analyser
        Dim I_Cour  As Long       ' indice courant de balayage des lignes
        Dim I_Dest  As Long       ' première ligne du résultat
        Dim NbLig   As Long       ' nombre de ligne d'une feuille
        Dim Col     As Integer    ' n° de la colonne à analyser
        Dim Critère As String     ' initiales saisies
        Dim Chaine  As String     ' chaine à analyser
        Dim FI      As Worksheet  ' feuille à analyser
        Dim FO      As Worksheet  ' feuille résultat
        
      '=====================================
        Set FI = Sheets("Feuil1") ' à adapter
        Set FO = Sheets("Feuil2") '     "
        I_Orig = 4                '     "
        I_Dest = 8                '     "
        Col = 6                   '     "
      '=====================================
      
        Critère = InputBox("Entrez les initiales à rechercher.", "RECHERCHE")
        If Critère = "" Then Exit Sub
        
        Application.ScreenUpdating = True
        
        FO.Activate
        NbLig = Cells(65536, 1).End(xlUp).Row
        Range(Cells(I_Dest, 1), Cells(NbLig, 1)).EntireRow.Cells.ClearContents
        
        NbLig = FI.Cells(65536, Col).End(xlUp).Row
        For I_Cour = I_Orig To NbLig
          Chaine = FI.Cells(I_Cour, Col).Value
          For I = 1 To Len(Chaine) - Len(Critère) + 1
            If UCase(Mid(Chaine, I, Len(Critère))) = UCase(Critère) Then
              FI.Cells(I_Cour, Col).EntireRow.Copy
              Cells(I_Dest, 1).Select
              ActiveSheet.Paste
              I_Dest = I_Dest + 1
              Exit For
            End If
          Next I
        Next I_Cour
        
        Application.ScreenUpdating = True
        
      End Sub
      
      0
      1. pouvez vous me contacter par e-mail?
        0
    2. enorme
      je transmet ces info à quelqu'un de + competent que moi mais si cela marche c'est enorme
      j'ai du mal à le croire!!
      encore merci.
      0
      1. pouvez vous me contacter par e-mail.
        0
        1. Ecris à mon pseudo en minuscules chez free.
          0