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

 

[Dudu2]

conclusion pour de grands tableaux je crois que rien ne vaut une boucle dico

En effet, la boucle Dico, mais sur un table des valeurs comme tu as fait et pas sur les cellules.

 

[patricktoulon]

ben pourquoi veux tu travailler sur les cellule ?
on prend le databodyrange dans une variable tableau et en avant gringuant

ps: je viens de me rendre compte que ce n'est pas le segment le coupable
bien que il est plus long c'est incontestable
en fait c'est ta boucle de reconstruction du string du résultat dans la sub a
je fait donc un join

Important(peut être)
par contre avec le segment il ressort les valeurs dans l'ordre chrono ou alpha (selon le type de donnée)
avec le dico ca ressort dans l'ordre de la plage original

Sub a()
    Dim TabValeursUniques() As Variant
    
    TabValeursUniques = TabValeursUniquesColonneTS(ActiveSheet.ListObjects(1), 2)
    
    MsgBox Join(TabValeursUniques, "|")
End Sub

Sub b()
    Dim TabValeursUniques
    
    TabValeursUniques = TabVDicoUniquesColonneTS(ActiveSheet.ListObjects(1), 1)
    
    MsgBox Join(TabValeursUniques, "|")
End Sub

Function TabVDicoUniquesColonneTS(TS As ListObject, index)
    Dim t, dic
    Set dico = CreateObject("Scripting.Dictionary")
    With TS
        t = .DataBodyRange
        For i = 1 To UBound(t)
            dico(t(i, 1)) = ""
        Next
        TabVDicoUniquesColonneTS = dico.keys
    End With
End Function

Function TabValeursUniquesColonneTS(Tbl As ListObject, TblNoColonne As Integer) As Variant()
    Dim SlicerItem As SlicerItem
    Dim Segment As Object
    Dim TabValeursUniques() As Variant
    Dim Workbook As Workbook
    Dim Worksheet As Worksheet
    Dim NomColonne As String
    Dim NomSegment As String
    Dim WorkbookSaved As Boolean
    Dim i As Long
    
    With Tbl
        Set Workbook = .Parent.Parent
        Set Worksheet = .Parent
        WorkbookSaved = Workbook.Saved
        NomColonne = .HeaderRowRange(TblNoColonne)
        NomSegment = "VALEURS_UNIQUES"
        
        On Error Resume Next
        Worksheet.Shapes(NomSegment).Delete
        On Error GoTo 0
        
        With .Range
            Set Segment = Workbook.SlicerCaches.Add(Tbl, NomColonne).Slicers.Add( _
                                                    Worksheet, , NomColonne, NomColonne, .Left, .Top, 100, 200)
        End With
        Segment.Name = NomSegment
    End With
    
    With Segment.SlicerCache
        ReDim TabValeursUniques(1 To .SlicerItems.Count)
        For Each SlicerItem In .SlicerItems
            i = i + 1
            TabValeursUniques(i) = SlicerItem.Name
        Next SlicerItem
    End With
    
    Segment.Delete
    Workbook.Saved = WorkbookSaved
    
    'Return value
    TabValeursUniquesColonneTS = TabValeursUniques
End Function

 

[nullosse]

salut,
et en utilisant le presse-papier ?

Sub CopierValeursVisiblesUniques_Tableau1()
   ' nullosse
   ' cocher Microsoft Forms 2.0 Object Library dans les référence Excel
    Dim tbl As ListObject, plageVisible As Range
    Dim DataObj As New MSForms.DataObject
    Dim texte As String, lignes() As String, ligne As Variant
    Dim dict As Object, sortie As String
    ' 1. Récupère le tableau
    Set tbl = ActiveSheet.ListObjects("Tableau1")
    ' 2. Copie uniquement les cellules visibles
    On Error Resume Next
    Set plageVisible = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    plageVisible.Copy
    DoEvents: DoEvents
    ' 3. Récupère le texte du presse-papiers via MSForms.DataObject
    DataObj.GetFromClipboard
    texte = DataObj.GetText
    Debug.Print texte
    'Désélectionne les cellules copiées
    Application.CutCopyMode = False
    ActiveSheet.Range("A1").Select
    ' 4. Crée un dictionnaire pour stocker les lignes uniques
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare  ' Ignorer la casse si besoin
    lignes = Split(texte, vbCrLf)
    For Each ligne In lignes
        If Trim(ligne) <> "" Then
            If Not dict.Exists(ligne) Then
                dict.Add ligne, Nothing
            End If
        End If
    Next ligne
    ' 5. Reconstitue le texte à partir des valeurs distinctes
    sortie = Join(dict.Keys, ",")
    MsgBox "Les valeurs filtrées et uniques " & vbCrLf & sortie
End Sub

Je ne sais pas à partir de combien de données le presse-papier ne fonctionne plus (saturation)

Nullosse

 

[Dudu2]

Ce qui est très ch*ant avec Excel c'est la confusion entre une valeur 0 et une valeur Empty.
Si Valeur = 0, (Valeur = Empty) = True
Si Valeur = Empty, (Valeur = 0) = True
Et ça se retrouve dans le Dico ! Voir la différence entre colonne #1 et colonne #2.

 

[Dudu2]

Il faut passer par la représentation String de la valeur ce qui augmente le temps de traitement.

 

[patricktoulon]

tiens teste ce classeur
click sur générer ca va te créer 4 colonne de 2 a 150 000
click sur le bouton de test avec le segment (normalement ici tu plante une erreur dépassement de capacité)
annule l'erreur(ne debug pas)
ensuite click sur le bouton avec le test dico
ensuite on reduit le tableau a 50 000 lignes en cliquant sur le bouton supprimer 100 000 lignes
refait les tests segment et dico

peut être ajouter eventuellement pour le dico if trim(t(i,1))<>"" je ne l'ai pas fait sur le coup

en tout cas on voit vraiment la limite avec un segment
donc a faire une fonction générique (que choisir)
et ça c'est une question que seul vous même pourrez répondre en fonction de vos convictions et fait avéré cité précédemment

Patrick
@nullosse
le presspapier je m'en sert pour convertir une plage en csv ou html de base (tres pratique et rapide )

 

[laurent950]

Bonjour @patricktoulon

Franchement l’explication de @Dudu2 n’est pas claire pour moi.
Peux-tu m’expliquer simplement le principe ?

Imaginons :

• On a un tableau avec X lignes sur Y colonnes, avec un filtre (activé)
• Exemple : on regarde une seule colonne, par exemple la colonne 5 (Y5) = (Sans Filtre Ou Avec Filtre activé)

Et ensuite ?
👉 C’est quoi exactement le résultat attendu ?
C’est ici que ça devient flou.

Comme toi tu sembles avoir mieux compris, je préfère que tu m’expliques.
Merci

 

[patricktoulon]

par contre @nulosse
d'apres toi
il est plus court et rapide de prendre une variable tableau et boucler sur ligne et colonne
ou
copier spliter par ligne / spliter ligne par colonne --> direction dico
perso je pense que la variable tableau sera plus rapide

 

[Dudu2]

peut être ajouter eventuellement pour le dico if trim(t(i,1))<>"" je ne l'ai pas fait sur le coup

Avec Trim tu as une conversion implicite de t(i, 1) en String et le résultat est aussi un String.
Donc un Cstr(t(i, 1)) va aussi bien et il différenciera les valeurs que Trim ne diffenciera pas.

 

[patricktoulon]

@laurent950

Et ensuite ?
👉 C’est quoi exactement le résultat attendu ?
C’est ici que ça devient flou.

Comme toi tu sembles avoir mieux compris, je préfère que tu m’expliques.
Merci

en effet tu a absolument raison
c'est devenu flou a partir du moment ou ils sont parti vers le segment (perso j'ai suivi le mouvement )

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
et là il y aurait deux sous solutions
boucle sur plage comlete if cell(index de la boucle is visible then on rempli le dico
ou
boucle sur visible cells

je suis parfaitement d'accords avec toi sur le fait que c'est devenu flou sur ce point

 

[patricktoulon]

@Dudu2

Avec Trim tu as une conversion implicite de t(i, 1) en String et le résultat est aussi un String.
Donc un Cstr(t(i, 1)) va aussi bien et il différenciera les valeurs que Trim ne diffenciera pas.

Non !! @Dudu2 ils faut pas oublier les espace non sécables qui pollue parfois nos tableau
le cstr(...) garderait cet/ces espaces

 

[laurent950]

pour tout de dire je pense que si on voulais lister UNIQUEMENT !!!!! les filtres (actifs!!!)donc cochés

Regarde en Poste #12 et Poste #13 Patrick j'ai poster le code dans le fichier excel

 

[Dudu2]

le cstr(...) garderait cet/ces espaces

Et alors ? Le but c'est de lister les valeurs uniques et "abc" ce n'est pas " abc ".

 

[nullosse]

c'est devenu flou a partir du moment ou ils sont parti vers le segment (perso j'ai suivi le mouvement )
pour tout de dire je pense que si on voulais lister UNIQUEMENT !!!!! les filtres (actifs!!!)donc cochés

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 ?

 

[laurent950]

@Dudu2

- pour Criteria1 / Operator / Critetia2, il peut y avoir des situations complexes (faut que je revoie ça pour expliquer)

il faut expliqué ici