Extraire une ligne selon un mot

Question

Je suis journaliste spécialisé dans le sport automobile et dans le cadre de mon travail je réalise une base de donnée avec de nombreux pilotes issus de catégories différentes où je recense différentes informations. J'ai donc une feuille avec ma liste de tous les pilotes, mais je souhaiterai créer une feuille pour chaque discipline. Je vous explique. Dans la colonne D, ce sont la ou les disciplines où concourt le pilote. IL faudrait que j'ai un bouton qui me cherche la discipline que je veux (Formule 1, WEC, ELMS, Formula E etc.) et qui me crée automatiquement une nouvelle feuille avec tous les lignes des pilotes qui ont ce critère dans la colonne D. J'imagine que cette problématique s'est déjà posée, mais après avoir passé deux jours à essayer de comprendre les macros mon résultat est nul, c'est pour cela que je viens vers vous. Merci d'avance, vous trouverez ci-joint mon fichier excel. Ayrton...

Klin89 · Accepted Answer

Re Ayrtonlem

feuille "Liste" ,j'ai placé :

en cellule J1 la formule volatile soit la date du jour :

=AUJOURDHUI()

en colonne E à partir de la ligne 2

la formule suivante à étirer vers le bas

=SI(H2="inconnu";"";ENT(($J$1-H2)/365,2425))

en colonne , j'ai aussi dressé la liste de tes disciplines, la 1ère cellule étant l'en-tête

Il faut bien laisser la colonne I vide

j'ai réaménagé le code en conséquence :

Option Explicit
Sub test()
Dim dico As Object, i As Long, x As Byte, e, discp
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    Application.ScreenUpdating = False
    With Sheets("Liste")
        'la liste des disciplines en colonne L avec un en-tête
         discp = .Range("l1", .Range("l" & Rows.Count).End(xlUp)).Value
        With .Cells(1).CurrentRegion
            For i = 2 To .Rows.Count
                For x = 2 To UBound(discp, 1)
                    If myFilter(.Cells(i, 4).Value, discp(x, 1)) Then
                        If Not dico.exists(discp(x, 1)) Then
                            Set dico(discp(x, 1)) = .Rows(1)
                        End If
                        Set dico(discp(x, 1)) = Union(dico(discp(x, 1)), .Rows(i))
                    End If
                Next
            Next
        End With
    End With
    For Each e In dico.keys
        If Not IsSheetExists(e) Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = e
        End If
        With Sheets(e).Cells(1)
            .CurrentRegion.Clear
            dico(e).Copy .Cells
            With .CurrentRegion
                .Columns(5).Offset(1).Resize(.Rows.Count - 1).Formula = _
                "=IF(H2=""inconnu"","""",INT((Liste!$J$1-H2)/365.2425))"
                '.Columns(5).Offset(1).Resize(.Rows.Count - 1).Formula = _
                 "=IF(rc[3]=""inconnu"","""",INT((dateJour-rc[3])/365.2425))"
                With .Rows(1)
                    .HorizontalAlignment = xlCenter
                End With
                .Columns.ColumnWidth = Array(10, 12, 5, 19, 5, 6, 28, 10)
            End With
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Function myFilter(ByVal txt As String, ByVal myPtn As String) As Boolean
    With CreateObject("VBScript.RegExp")
        .Pattern = "\b" & myPtn & "\b"
        myFilter = .test(txt)
    End With
End Function

Function IsSheetExists(ByVal sn As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(sn).Name)
End Function

klin89

Dan42153 · Answer

Je dirais que c'est un problème de structure : à un pilote peuvent correspondre plusieurs disciplines et plusieurs lignes de palmarès... Il te faudrait donc, à mon avis : une feuille avec les pilotes (1 ligne = 1 pilote) une feuille avec les disciplines (1 ligne = 1 discipline) une feuille avec les inscriptions (une ligne = 1 pilote + 1 discipline + l'année + le classement du pilote) Des formules (Recherchev, Equiv/Index) te permettront, avec l'aide éventuelle de ce forum, de faciliter et de contrôler la saisie dans chaque feuille, et les outils filtre (même pas élaboré) et tableaux croisés te donneront tout le reste... Si tu es d'accord pour modifier ta structure, bien sûr... Cordialement, Daniel...

Dan42153 · Answer

La feuille Pilotes : - Nom, prénom, naissance, âge (ta formule), nationalité, observations La feuille Disciplines : - Libellé, observations... La feuille Ecuries (c'est bien comme ça que ça s'appelle, non ?) - Libellé, observations La feuille Engagements (au lieu d'Inscriptions : chaque fois qu'un pilote s'engage dans une compétition) : Pilote, Ecurie, Discipline, Année, Palmarès, Observations + formules : Age du Pilote (récupéré dans la feuille Pilotes), etc... Les filtres automatiques seront applicables sur toutes ces données... (exemple : historique des vainqueurs de telle discipline...) Voilà ce que je ferais, quant à moi... Cordialement, Daniel...

Dan42153 · Answer

Oui, je pensais bien à un truc comme ça (il m'arrive d'écouter les commentateurs sportifs de temps à autre !), et par exemple pouvoir donner à la volée :

l'historique des vainqueurs de telle compète (exemple déjà cité)
le palmarès de tel pilote ou de telle écurie
etc...

Je suis sûr que tu trouveras 25 millliards d'autres exemples : il suffit de disposer des données et de les répartir dans les feuilles de telle façon qu'il soit rapide et aisé de les obtenir. Ici, pas de macro, ni rien de ce genre : tous ces exemples sont basés sur les filtres auto, et surtout, sur la feuille Engagements : c'est elle qui contiendra les données significatives !

J'essaie de te faire une maquette ?

Mais tu peux faire ça sans filtre élaboré ni macro, ni bouton, et dans ton fichier actuel sans rien changer !

Pose tes filtres automatiques (Données / Entonnoir)
choisis Filtre textuel / Contient dans la colonne Disciplines 2017
saisis ELMS dans la zone de critères et valide
c'est tout !

L'avantage, c'est que ce qui fonctionne dans une colonne va fonctionner partout : les ages, les nationalités, etc... Tu peux même filtrer par couleur ...

Klin89 · Answer

Effectivement, le mieux est d'ajouter une colonne dans laquelle figurera le nom de l'équipe où concourt le pilote. Ensuite, la colonne D peut rester en l'état, c'est à dire plusieurs disciplines séparées par un retour chariot. Il suffira de parcourir les cellules de la colonne D en les splittant et ainsi créer une feuille pour chaque discipline. klin89...

Klin89 · Answer

Re Ayrtonlem

A tester :

Option Explicit
Sub test()
Dim dico As Object, i As Long, e
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    Application.ScreenUpdating = False
    With Sheets("Liste").Cells(1).CurrentRegion
        For i = 2 To .Rows.Count
            For Each e In Split(.Cells(i, 4).Value, vbLf)
                If Not dico.exists(e) Then
                    Set dico(e) = .Rows(1)
                End If
                Set dico(e) = Union(dico(e), .Rows(i))
            Next
        Next
    End With
    For Each e In dico.keys
        If Not IsSheetExists(e) Then
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = e
        End If
        With Sheets(e).Cells(1)
            .CurrentRegion.Clear
            dico(e).Copy .Cells
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Function IsSheetExists(ByVal sn As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(sn).Name)
End Function

klin89

Amadéus · Answer

Une approche différente Un code de Feuille et un code Module Cordialement...

Dan42153 · Answer

Question : quelle est la différence entre le filtre élaboré, avec macro qui devra être adaptée pour tout autre critère, et le filtre automatique textuel sur place, qui peut fonctionner sur n'import quelle colonne, sans macro... ...

Amadéus · Answer

Avec un filtre élaboré,avec ou sans macro, tu peux extraire le résultat sur une autre feuille Cordialement...

Dan42153 · Answer

Oui, oui, on est d'accord, mais à part le fait qu'on se retrouve sur une autre feuille, avec des données qu'il vaut mieux ne pas modifier parce que ça ne met pas à jour les données d'origine, etc... ...

Klin89 · Answer

Ayrtonlem, j'ai fait appel à une fonction personnalisée de type Boolean utilisant un pattern C'est un peu long, mais cela devrait le faire N'oublie pas de compléter la variable discp du nom de toutes les disciplines séparées par un Option Explicit Sub test() Dim dico As Object, i As Long, e, discp As String Set dico = CreateObject("Scripting.Dictionary") dico.CompareMode = 1 discp = "WRC|Formula E|WEC|ELMS|IMSA|NASCAR Xfinity|NASCAR Cup|Formule 1|TCR|IndyCar|FIA F3|Supercars|WRC2" Application.ScreenUpdating = False With Sheets("Liste").Cells(1).CurrentRegion For i = 2 To .Rows.Count For Each e In Split(discp, "|") If myFilter(.Cells(i, 4).Value, e) Then If Not dico.exists(e) Then Set dico(e) = .Rows(1) End If Set dico(e) = Union(dico(e), .Rows(i)) End If Next Next End With For Each e In dico.keys If Not IsSheetExists(e) Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = e End If With Sheets(e).Cells(1) .CurrentRegion.Clear dico(e).Copy .Cells With .CurrentRegion With .Rows(1) .HorizontalAlignment = xlCenter End With .Columns.ColumnWidth = Array(10, 12, 5, 19, 5, 6, 28, 10) End With End With Next Application.ScreenUpdating = True End Sub Function myFilter(ByVal txt As String, ByVal myPtn As String) As Boolean With CreateObject("VBScript.RegExp") .Pattern = "\b" &amp; myPtn &amp; "\b" myFilter = .test(txt) End With End Function Function IsSheetExists(ByVal sn As String) As Boolean On Error Resume Next IsSheetExists = Len(Sheets(sn).Name) End Function klin89...

Amadéus · Answer

Oserais-je te faire remarquer que dans le fichier avec filtre élaboré que j'ai envoyé, l'ensemble des formats est reproduit sur l'autre feuille? Cordialement...

Klin89 · Answer

Re Ayrtonlem

En colonne D, j'ai relevé quelques irrégularités dans le contenu des cellules.

tu dis afficher tes données de cette façon :

Le problème en effet étant que certains pilotes concourent dans plusieurs disciplines différentes
Je ne l'ai pas précisé, mais ce qui est entre parenthèses dans la colonne D correspond à l'équipe dans la quelle le pilote évolue dans telle ou telle discipline.

Or certaines cellules semblent échapper à la règle énoncée.

Dans l'image ci-dessous, quelles sont les différentes disciplines en colonne A ?

Pour bien comprendre, exécute cette macro dans le fichier joint et dis moi si l'extraction des disciplines est correct dans chacune des 2 feuilles.

Option Explicit
Sub test()
Dim r As Range, i As Long, e
Dim RegX As Object
    Set RegX = CreateObject("VBScript.RegExp")
    With RegX
        .Pattern = "([^\(\n]+)?[ \n]+\(([^\(\)]+)\)"
        .Global = True
    End With
    For Each e In Array("Liste", "Irregularites")
        With Sheets(e)
            For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                If RegX.test(r.Value) Then
                    For i = 0 To RegX.Execute(r.Value).Count - 1
                        r(, i + 3).Value = RegX.Execute(r.Value)(i).submatches(0)
                    Next
                End If
            Next
        End With
    Next
End Sub

L'objectif est de définir les différentes clés du dictionnaire sans passer par une liste comme dans l'exemple précédent.

klin89

9classeur-y1.zip (17.44 Ko)