XL 2016 VBA - Est-il possible de récupérer toutes les valeurs de filtre possible sans parcourir la colonne

[Dudu2]

Bonjour,

Supposons un colonne qui peut être filtrée et qui est ou non filtrée.
Peut-on récupérer toutes les valeurs listées dans la liste déroulante du filtre sans parcourir les données.

Soit ce tableau:

Je voudrais récupérer ça:

ou

 

[laurent950]

@Dudu2

Poste un classeur excel, avec le filtre activé sur la colonne de ton choix, fait des opérations "pour Criteria1 / Operator / Critetia2, il peut y avoir des situations complexes (faut que je revoie ça pour expliquer)"

enregistre le classeur
donne nous le resultat (N° de colonnes choisies) et le resultat que tu souhaite Obtenir

explique nous ta démarche.

 

[Dudu2]

@nullosse,

Dudu2 dis-nous si ce que j'affiche dans le gif animé de mon post #64 c'est ce que tu veux ou bien autre chose ?

Non, j'ai vu que tu ne prenais que les visible cells, donc tu récupères une liste de valeurs après filtre.

J'aurais dû dire, quelque soit le filtre appliqué à la colonne, je veux la liste des valeurs uniques sans parcours des valeurs, ce que les Segments permettent mais avec une performance dégradée. Donc au final seul le parcours de toutes les valeurs permet d'obtenir le résultat.

J'ai dit en Post 1.
Je voudrais récupérer ça:

Ça me semble explicite mais apparemment pas !

 

[laurent950]

@Dudu2

J'aurais dû dire, quelque soit le filtre appliqué à la colonne, je veux la liste des valeurs uniques sans parcours des valeurs

Sur 1 colonne (uniquement) mais alors qu'elle colonne sur plusieurs colonnes ? comment la choisir via VBA ?
Ça me semble explicite mais apparemment pas ! (c'est a moitier expliqué)

 

[Dudu2]

@patricktoulon, @laurent950,

pour tout de dire je pense que si on voulais lister UNIQUEMENT !!!!! les filtres (actifs!!!)donc cochés
il n'y aurait qu'une solution
boucle sur le visible de la plage

S'il y a filtre on peut récupérer les valeurs sur les filtres.
De mes vielles fonctions...

'-----------------------------------------------------------------------
'Return = True si il y a des colonnes filtrées dans un tableau structuré
'-----------------------------------------------------------------------
Public Function ExisteColonnesFiltréesTS(Tbl As ListObject) As Boolean
    With Tbl
        'Il n'y a pas de filtres (cas particulier où les filtres ont été retirés via Données/Filtrer)
        If .AutoFilter Is Nothing Then Exit Function
 
        'Aucune colonne n'est filtrée
        If .AutoFilter.FilterMode = False Then Exit Function
    End With
 
    'Return value
    ExisteColonnesFiltréesTS = True
End Function

'-------------------------------------------------------
'Critères de filtre d'une colonne d'un Tableau Structuré
'Return: Tableau des valeurs des critères de filtre
'        Le Tableau sera vide si il n'y a pas de filtre
'        If (Not (Not Tableau)) = 0 then <Tableau vide>
'-------------------------------------------------------
Public Function TabCriteria1FiltresColonneTS(Tbl As ListObject, TblNoColonne As Integer) As Variant()
    Dim TabCritères() As Variant
    Dim Criteria1 As Variant
    Dim Criteria2 As Variant
    Dim Operator As Variant
    Dim ErrNumber As Long
    Dim i As Integer

    'Contrôle sur numéro de colonne
    If Not (TblNoColonne >= 1 And TblNoColonne <= Tbl.ListColumns.Count) Then GoTo SetReturnValue
  
    'La colonne n'est pas filtrée
    If Not ExisteColonnesFiltréesTS(Tbl) Then GoTo SetReturnValue

    With Tbl
        With .AutoFilter
            On Error Resume Next
            Criteria1 = .Filters(TblNoColonne).Criteria1
            ErrNumber = Err.Number
            On Error GoTo 0

            'Pas de Critéria1
            If Not ErrNumber = 0 Then GoTo SetReturnValue
          
            'Seuls opérateurs traités
            Operator = .Filters(TblNoColonne).Operator
            If Not (Operator = 0 Or Operator = xlFilterValues Or Operator = xlOr) Then
                MsgBox "Function TabCriteria1FiltresColonneTS: Operator = " & Operator & "non supporté !"
                GoTo SetReturnValue
            End If
          
            'Criteria1 = tableau de valeurs
            If IsArray(Criteria1) Then
                ReDim TabCritères(1 To UBound(Criteria1))
                For i = LBound(Criteria1) To UBound(Criteria1)
                    TabCritères(i) = IIf(Left(Criteria1(i), 1) = "=", Mid(CStr(Criteria1(i)), 2), CStr(Criteria1(i)))
                Next i
          
            'Critéria1 = une seule valeur
            Else
                On Error Resume Next
                'Critéria2 = une valeur
                Criteria2 = .Filters(TblNoColonne).Criteria2
                Operator = .Filters(TblNoColonne).Operator
                ErrNumber = Err.Number
                On Error Resume Next
              
                If Err.Number = 0 And Operator = xlOr Then
                    ReDim TabCritères(1 To 2)
                    TabCritères(1) = IIf(Left(Criteria1, 1) = "=", Mid(CStr(Criteria1), 2), CStr(Criteria1))
                    TabCritères(2) = IIf(Left(Criteria2, 1) = "=", Mid(CStr(Criteria2), 2), CStr(Criteria2))
                Else
                    ReDim TabCritères(1 To 1)
                    TabCritères(1) = IIf(Left(Criteria1, 1) = "=", Mid(CStr(Criteria1), 2), CStr(Criteria1))
                End If
            End If
        End With
    End With
  
SetReturnValue:
    'Return Value
    TabCriteria1FiltresColonneTS = TabCritères
End Function

Mais il faut que l'Operator soit 0 (pas d'Operator), xlFilterValues ou xlOr.

 

[laurent950]

S'il y a filtre on peut récupérer les valeurs sur les filtres.

d'accord mais qu'elle colonne ?
sur 1 colonne ou toutes les colonnes ?
si c'est sur toutes les colonnes a quoi cela sert d'avoir la case Vide ?
enfin ! poster un fichier avec un etat (enregistrer) puis montrer les valeurs qui doivent etre affiché
un exemple mieux que le code

 

[nullosse]

et avec la fonction formule
Unique ?

 

[Dudu2]

En 2016, elle n'existe apparemment pas.

d'accord mais qu'elle colonne ?
sur 1 colonne ou toutes les colonnes ?

Sur 1 colonne désignée.

 

[nullosse]

En 2016, elle n'existe apparemment pas.

Regarde la pièce jointe 1222477

Sur 1 colonne désignée.

Effectivement elle n'existe que depuis Excel 2021
avec ce code dans Excel 2021:

tabval = Application.Transpose(WorksheetFunction.Unique(tbl.DataBodyRange))

je récupère les valeurs uniques du tableau à 1 colonne dans un array (tabval) sans boucler sur les éléments

 

[Dudu2]

Je pense que la récupérations des valeurs de filtre du Post #80 n'est valide que si les valeurs d'Operator sont:
- 0 (pas d'Operator)
- xlFilterValues
- xlOr

Pour toutes les autres valeurs de Operator de l'énumération, on ne peut déduire les valeurs uniques filtrées qu'en parcourant les VisibleCells.

 

[Dudu2]

Je l'ai déjà dit en Post #10, il y a une méthode pour trouver la totalité des valeurs uniques sans parcourir les valeurs.

- Défiltrer la colonne
- Ajouter une valeur barbare en fin de colonne
- Filtrer sur tout sauf celle valeur
- Récupérer les valeurs de filtre
- Supprimer la ligne générée par l'ajout de la valeur barbare
- Restorer les filtres d'origine

Je dois avoir toutes les fonctions qui vont bien pour faire ça, mais plus tard car je déconnecte pour le moment.

Edit: ma jolie théorie s'effondre car en filtrant sur tout sauf la valeur barbare, les autres valeurs de filtre n'apparaissent pas en liste des critères de filtre.

La preuve en image avec le fichier joint qui contient quand même quelques fonctions utiles sur les filtres.

 

[patricktoulon]

selon l'idée de @nulosse
avec le clipboard on recupère les filtres cochés d'une colonne désignées par son index
on traite le vide si il y est

Sub d()
    Dim TabValeursUniques
    TabValeursUniques = TabclipBoardValeursUniquesColonneTS(ActiveSheet.ListObjects(1), 1)
    MsgBox Join(TabValeursUniques, vbCrLf)
End Sub

Function TabclipBoardValeursUniquesColonneTS(tbl As ListObject, TblNoColonne As Integer)
    Dim DataObj, texte
    tbl.DataBodyRange.Columns(TblNoColonne).SpecialCells(xlCellTypeVisible).Copy
    Set DataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    DataObj.GetFromClipboard
    texte = Replace(DataObj.GetText, vbCrLf, "|")
    Application.CutCopyMode = False
    If Left(texte, 1) = "|" Then texte = "(vides)" & Mid(texte, 1, Len(texte) - 2)
    TabclipBoardValeursUniquesColonneTS = Split(texte, "|")
End Function

mais Attention la encore ça mouline si il n'y a pas de filtre et si la plage est relativement grande

plus ça va plus je suis conforté dans mon opinion la boucle dico reste la méthode la plus simple et plus rapide

 

[laurent950]

plus ça va plus je suis conforté dans mon opinion la boucle dico reste la méthode la plus simple et plus rapide

Vrai @patricktoulon

 

[nullosse]

avec ce code dans Excel 2021:

tabval = Application.Transpose(WorksheetFunction.Unique(tbl.DataBodyRange))

je récupère les valeurs uniques du tableau à 1 colonne dans un array (tabval) sans boucler sur les éléments

A mon avis la fonction WorksheetFunction.Unique doit être la méthode la plus rapide en VBA pour supprimer les doublons d'un tableau.
Pour un tableau composé de 250000 chaînes aléatoires de 8 lettres j'obtiens un temps de 45ms et dans le tableau résultat j'ai 53393 valeurs.
Mais hélas cette fonction n'existe que depuis Excel 2021

 

[laurent950]

@nullosse si c'est un.filtre sur couleurs ?

Il faut écrire la règle.
Tableau ou tableau structuré
Filtre
Qu'elle colonne (1 ou.ou plusieurs)
C'est colonnes sont en états de Filtre actif ou pas
Si oui (comment les critères)
Si oui les couleurs
Et qu elle résultat attendu !

La vitesse c'est a voir ensuite...

Qui écrit la règle ?

 

[nullosse]

La vitesse c'est a voir ensuite...

Moi j'ai juste donné une info . A voir si cela peut servir à quelqu'un un jour dans d'autres codes.