XL 2021 Afficher la valeur Min d'un tableau structuré avec une macro

[Alex Bou]

Bonjour,

Je n'arrive pas à trouver moi-même comment faire pour afficher les lignes correspondant à la valeur min dans un tableau structuré. J'ai fais un shéma pour que ce soit plus simple à comprendre :

Imaginons que le tableau s'appelle "élèves". Merci de me dire si c'est possible. Bonne journée !

 

[Phil69970]

Bonjour @Alex Bou

Très belle image

A mon tour de te proposer une image pour la réponse

 

[chris]

Bonjour à tous

Il suffit d'ajouter une colonne avec une formule et un segment. Pas besoin de coder.

 

[Dudu2]

Bonjour,

Son truc est quand même basé sur des filtres.

Donc je pense qu'il faut coder pour:
1 - trouver le minimum de la colonne Jours d'ancienneté
2 - filtrer en = minimum pour le 1er bouton
3 - filtrer en > (ou Not =) minimum pour le 2ème bouton

Sans fichier (anonymisé) personne ne fera rien (ou quelque chose c'est selon).

 

[klin89]

Bonsoir à tous,

Pour t'aider :
En supposant qu'il y ait une ligne d'en-têtes et que l'on cherche le minimum en colonne C, tu peux utiliser la fonction Filter pour récupérer les numéros de ligne concernés dans la variable x.

Sub test()
    Dim x, minValue As Long
    minValue = Application.Min(Range("c2:c100"))
    With Range("c2:c100")
        x = Filter(Evaluate("transpose(if(" & .Address & "=" & _
                            minValue & ",row(" & .Address & ")))"), False, 0)
    End With
End Sub

klin89

 

[TooFatBoy]

Bonjour,

Une proposition :

Sub Mini()
'
    Call Filtrer("=")

End Sub

Sub PasMini()
'
    Call Filtrer("<>")

End Sub

Sub Filtrer(Critere As String)
'
Dim EtatFiltrage As AutoFilter
Dim Mini As Integer

    Application.ScreenUpdating = False

    ' Le filtrage du TS est-il activé ?
    Set EtatFiltrage = Range("élèves").ListObject.AutoFilter

    ' Si le filtrage du TS est activé on le désactive
    If Not EtatFiltrage Is Nothing Then Range("élèves").ListObject.DataBodyRange.AutoFilter

    ' Recherche de la valeur minimale dans la colonne "Jours d'ancienneté"
    Mini = WorksheetFunction.Min(Range("élèves[Jours d''ancienneté]"))
    ' Activation du filtre avec la valeur minimale
    Range("élèves").ListObject.DataBodyRange.AutoFilter Field:=4, Criteria1:=Critere & Mini

End Sub

 

[chris]

Bonjour à tous

Je persiste à considérer inutile de coder

S'il faut 2 tableaux supplémentaires à la source, 2 formules FILTRE suffisent pour extraire sans toucher à l'original....

 

[klin89]

Re à tous,

Pour le fun, créer au préalable la Feuil2 pour la restitution des lignes filtrées.

Sub test()
    Dim arr, x, minValue As Long
    Sheets("Feuil2").[a1].CurrentRegion.Clear
    With Sheets("Feuil1").[b2].CurrentRegion
        minValue = Application.Min(.Columns(4))
        x = Filter(.Parent.Evaluate("transpose(if((isnumber(" & .Columns(4).Address & ")=" _
                                    & "true)*(" & .Columns(4).Address & "=" & minValue & _
                                    "),row(1:" & .Rows.Count & ")))"), False, 0)

        If UBound(x) = -1 Then Exit Sub
        arr = Application.Index(.Value, Application.Transpose(x), [transpose(row(1:4))])
        If UBound(x) = 0 Then
            Sheets("Feuil2").[a1].Resize(, UBound(arr)) = arr
        Else
            Sheets("Feuil2").[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
        End If
    End With
End Sub

Mais bon, je rejoins l'avis de Chris.
klin89

 

[mapomme]

Bonsoir à tous ,

Tout comme pour @chris (que je salue), pour moi, il n'y a rien a faire à part une formule en colonne ancienneté : =AUJOURDHUI()-[@[Date arrivée]]

Ensuite le filtre de la colonne "ancienneté" suffit à faire ce qu'on veut :

• Afficher les minimums : on désélectionne tout et on ne coche que la première valeur numérique du filtre (qui sera forcément le minimum puisque le filtre classe les valeurs de choix par ordre croissant)
• afficher tout sauf les minimums : on sélectionne tout puis on décoche la première valeur proposée par le filtre (qui sera forcément le minimum...)

 

[klin89]

Re le forum,

On peut afficher le résultat des 2 filtres sur 2 feuilles que l'on aura créées au préalable, en l'occurrence les feuilles "Minimum" et "Autres".

Sub test()
    Dim arr, x, e, minValue As Long
    Sheets("Minimum").[a1].CurrentRegion.Clear
    Sheets("Autres").[a1].CurrentRegion.Clear
    With Sheets("Feuil1").[b2].CurrentRegion
        minValue = Application.Min(.Columns(4))
        For Each e In Array(Array("=", "Minimum"), Array("<>", "Autres"))
            x = Filter(.Parent.Evaluate("transpose(if((isnumber(" & .Columns(4).Address & ")=" _
                                        & "true)*(" & .Columns(4).Address & e(0) & minValue & _
                                        "),row(1:" & .Rows.Count & ")))"), False, 0)

            If UBound(x) = -1 Then Exit Sub
            arr = Application.Index(.Value, Application.Transpose(x), [transpose(row(1:4))])
            If UBound(x) = 0 Then
                Sheets(e(1)).[a1].Resize(, UBound(arr)) = arr
            Else
                Sheets(e(1)).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
            End If
        Next
    End With
End Sub

klin89

 

[klin89]

En attendant le retour de Alex Bou, version tableau structuré

Sub test()
    Dim x, arr, e, minValue As Long
    Dim tbl1 As ListObject, colRng As Range

    ' Définir le tableau structuré
    Set tbl1 = Sheets("Feuil1").ListObjects("Tableau1")

    ' Effacer les données des feuilles de destination
    Sheets("Minimum").[a1].CurrentRegion.Clear
    Sheets("Autres").[a1].CurrentRegion.Clear

    ' Définir la colonne à vérifier (4ème colonne du tableau structuré)
    Set colRng = tbl1.ListColumns(4).DataBodyRange

    ' Trouver la valeur minimale dans la colonne 4
    minValue = Application.Min(colRng)

    ' Boucler sur les conditions pour Minimum et Autres
    For Each e In Array(Array("=", "Minimum"), Array("<>", "Autres"))
        ' Utiliser la fonction Filter et Evaluate pour obtenir les lignes correspondantes
        x = Filter(colRng.Parent.Evaluate("transpose(if((" & colRng.Address & e(0) & minValue & _
                                          "),row(1:" & colRng.Rows.Count & ")))"), False, 0)

        ' Si aucune ligne n'est trouvée, quitter la boucle
        If UBound(x) = -1 Then Exit Sub

        ' Extraire les lignes correspondantes dans le tableau
        arr = Application.Index(tbl1.DataBodyRange.Value, Application.Transpose(x), [transpose(row(1:4))])

        'Coller l'entete dans la feuille de destination
        Sheets(e(1)).[a1].Resize(, 4) = tbl1.HeaderRowRange.Value
       
        ' Redimensionner et coller les données dans les feuilles de destination
        If UBound(x) = 0 Then
            Sheets(e(1)).[a2].Resize(, UBound(arr)) = arr
        Else
            Sheets(e(1)).[a2].Resize(UBound(arr), UBound(arr, 2)) = arr
        End If
    Next
End Sub

klin89