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

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Dudu2
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Dudu2

Dudu2

XLDnaute Barbatruc
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:
1757853539139.png


Je voudrais récupérer ça:
1757853684753.png
ou
1757854549856.png
 
Dernière édition:
Trier par date Trier par votes
@patricktoulon

VB: 
' SendKeys – décocher seulement le premier item après “Sélectionner tout”
Sub SendKeys_DecocherPremierItem()
' Si le filtre est actif, le désactive pour repartir propre
    If ActiveSheet.AutoFilterMode Then
        On Error Resume Next ' en cas où aucun filtre appliqué
        ActiveSheet.ShowAllData
        On Error GoTo 0
    End If
    
    [A1].Select
    If Not ActiveCell Is Nothing Then
        Dim sh As Object
        Set sh = CreateObject("WScript.Shell")
       
        ' Ouvre le menu AutoFilter
        sh.SendKeys "%{DOWN}", True
        
        ' Descend sur le premier item après "Sélectionner tout"
        sh.SendKeys "{DOWN 9}", True ' premier item
        sh.SendKeys " ", True        ' décocher le premier item
        
        ' Valide et ferme le menu
        sh.SendKeys "{ENTER}", True
    End If
End Sub

' SendKeys – décocher tout et cocher le premier item
 Sub SendKeys_DecocherTout_CocherPremier()
' Si le filtre est actif, le désactive pour repartir propre
    If ActiveSheet.AutoFilterMode Then
        On Error Resume Next ' en cas où aucun filtre appliqué
        ActiveSheet.ShowAllData
        On Error GoTo 0
    End If
    
    [A1].Select
    If Not ActiveCell Is Nothing Then
        Dim sh As Object
        Set sh = CreateObject("WScript.Shell")
       
        ' Ouvre le menu AutoFilter
        sh.SendKeys "%{DOWN}", True
        
        ' Descend sur "Sélectionner tout" et décoche
        sh.SendKeys "{DOWN 8}", True
        sh.SendKeys " ", True ' décocher tout
        
        ' Descend sur le premier item et coche
        sh.SendKeys "{DOWN}", True  ' premier item
        sh.SendKeys " ", True       ' coche
        
        ' Valide et ferme le menu
        sh.SendKeys "{ENTER}", True
    End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
@patricktoulon

Presque !

VB: 
Sub ListeFiltreTest()
' LireValeursFiltre
  Dim ws As Worksheet
  Dim f As AutoFilter
  Dim filtre As Filter
  Dim arr As Variant
'
    Set ws = ActiveSheet
'
' Le choix de la colonne de La Matrice (Le tableau = La Plage)
' Ici Choix de la colonne 1
    Dim Colonne As Integer ' Choix de la colonne ici la colonne 1
        Colonne = 1
'
    Dim Critére As Range
    Set Critére = ws.Cells(1, 1)
        Critére.Select
'
' Activer le filtre si ce n'est pas déjà fait
    If ws.AutoFilterMode = True Then
'   --- SendKeys_DecocherPremierItem (du Filtre) ---
        SendKeys_DecocherTout_CocherPremier
        Set f = ws.AutoFilter
        Set filtre = f.Filters(Colonne)
            If filtre.On Then
'           --- Argument = strictement Différent de l'argument.
                StockTableau ws, f, filtre, arr
                arr(UBound(arr)) = "Vide"
                ReDim Preserve arr(1 To UBound(arr) + 1)
'           --- SendKeys_DecocherTout_CocherPremier (du Filtre) ---
                SendKeys_DecocherTout_CocherPremier
                StockTableau ws, f, filtre, arr
'           --- Désactiver le filtre si nécessaire ---
                'ws.AutoFilterMode = False
            End If
    End If
    ' Transformer en chaîne, supprimer "=", puis recréer le tableau
    arr = Split(Replace(Join(arr, "|"), "=", ""), "|")
    MsgBox Join(arr, vbCrLf), vbInformation, "Contenu du tableau"
End Sub
'
' ==================================================================================================
'
Private Sub StockTableau(ByVal ws As Worksheet, ByVal f As AutoFilter, ByVal filtre As Filter, ByRef arr As Variant)
    Set f = ws.AutoFilter
    If Not f Is Nothing Then
        Set filtre = f.Filters(1) ' Exemple : première colonne filtrée : f.Filters(1)
        If filtre.On Then
            ' Criteria1
                'Debug.Print "Critère appliqué : " & "filtre.Criteria1"
            ' --- Charger dans un tableau ---
                    If IsArray(arr) Then
                        If UBound(arr) > 0 Then
                            'x = True
                            arr(UBound(arr)) = filtre.Criteria1
                        Else
                            'x = False
                        End If
                    Else
                        'MsgBox "Tableau vide"
                        arr = filtre.Criteria1
                    End If
            ' Criteria2
                If filtre.Operator = xlOr Then
                    'Debug.Print "OU Critère2 : " & filtre.Criteria2
                End If
        End If
    End If
End Sub
'
' ==================================================================================================
'
' SendKeys – décocher seulement le premier item après “Sélectionner tout”
Sub SendKeys_DecocherPremierItem()
' Si le filtre est actif, le désactive pour repartir propre
'    If ActiveSheet.AutoFilterMode Then
'        On Error Resume Next ' en cas où aucun filtre appliqué
'        ActiveSheet.ShowAllData
'        On Error GoTo 0
'    End If
    
    If Not ActiveCell Is Nothing Then
        Dim sh As Object
        Set sh = CreateObject("WScript.Shell")
      
        ' Ouvre le menu AutoFilter
        sh.SendKeys "%{DOWN}", True
        
        ' Descend sur le premier item après "Sélectionner tout"
        sh.SendKeys "{DOWN 9}", True ' premier item
        sh.SendKeys " ", True        ' décocher le premier item
        
        ' Valide et ferme le menu
        sh.SendKeys "{ENTER}", True
    End If
End Sub

' SendKeys – décocher tout et cocher le premier item
 Sub SendKeys_DecocherTout_CocherPremier()
' ' Si le filtre est actif, le désactive pour repartir propre
'    If ActiveSheet.AutoFilterMode Then
'        On Error Resume Next ' en cas où aucun filtre appliqué
'        ActiveSheet.ShowAllData
'        On Error GoTo 0
'    End If
    
    If Not ActiveCell Is Nothing Then
        Dim sh As Object
        Set sh = CreateObject("WScript.Shell")
      
        ' Ouvre le menu AutoFilter
        sh.SendKeys "%{DOWN}", True
        
        ' Descend sur "Sélectionner tout" et décoche
        sh.SendKeys "{DOWN 8}", True
        sh.SendKeys " ", True ' décocher tout
        
        ' Descend sur le premier item et coche
        sh.SendKeys "{DOWN}", True  ' premier item
        sh.SendKeys " ", True       ' coche
        
        ' Valide et ferme le menu
        sh.SendKeys "{ENTER}", True
        End If
End Sub
 
Vote positif 0 Vote négatif
patricktoulon à dit:
aben la bonne blahue tête d'ail !!! sur le vbe tu crois que les sendkeys vont taper ou 🤪 🤪 🤣 🤣 🤣 🤣
Cliquez pour agrandir...

@patricktoulon merci pour l'explication SendKeys

C'est presque bon et rapide ci cela arrive a ce chaînée !
on arrive a stocké les valeur de la liste sans boucle en 2 Passages "arr = filtre.Criteria1
" et "arr(UBound(arr)) = filtre.Criteria1" (Ultra Rapide Normalement : bien sûr sans cela "Application.Wait Now + TimeValue("0:00:01") ' Un Essaie non concluant !"

il fonctionne bien indépendamment
' A --- SendKeys_DecocherPremierItem (du Filtre) ---
SendKeys_DecocherPremierItem
VB: 
' SendKeys – décocher seulement le premier item après “Sélectionner tout”
Sub SendKeys_DecocherPremierItem()
' Si le filtre est actif, le désactive pour repartir propre
    If ActiveSheet.AutoFilterMode Then
        On Error Resume Next ' en cas où aucun filtre appliqué
        ActiveSheet.ShowAllData
        On Error GoTo 0
    End If
 
    [A1].Select ' A modifier par la suite = Critére.Select
    If Not ActiveCell Is Nothing Then
        Dim sh As Object
        Set sh = CreateObject("WScript.Shell")
  
        ' Ouvre le menu AutoFilter
        sh.SendKeys "%{DOWN}", True
    
        ' Descend sur le premier item après "Sélectionner tout"
        sh.SendKeys "{DOWN 9}", True ' premier item
        sh.SendKeys " ", True        ' décocher le premier item
    
        ' Valide et ferme le menu
        sh.SendKeys "{ENTER}", True
    End If
End Sub

' B --- SendKeys_DecocherTout_CocherPremier (du Filtre) ---
SendKeys_DecocherTout_CocherPremier
Code: 
' SendKeys – décocher tout et cocher le premier item
 Sub SendKeys_DecocherTout_CocherPremier()
 ' Si le filtre est actif, le désactive pour repartir propre
    If ActiveSheet.AutoFilterMode Then
        On Error Resume Next ' en cas où aucun filtre appliqué
        ActiveSheet.ShowAllData
        On Error GoTo 0
    End If
 
    [A1].Select ' A modifier par la suite = Critére.Select
    If Not ActiveCell Is Nothing Then
        Dim sh As Object
        Set sh = CreateObject("WScript.Shell")
  
        ' Ouvre le menu AutoFilter
        sh.SendKeys "%{DOWN}", True
    
        ' Descend sur "Sélectionner tout" et décoche
        sh.SendKeys "{DOWN 8}", True
        sh.SendKeys " ", True ' décocher tout
    
        ' Descend sur le premier item et coche
        sh.SendKeys "{DOWN}", True  ' premier item
        sh.SendKeys " ", True       ' coche
    
        ' Valide et ferme le menu
        sh.SendKeys "{ENTER}", True
        End If
End Sub


mais impossible de les faire fonctionner a la suite ?
Code: 
Sub Lancement()
'   --- SendKeys_DecocherPremierItem (du Filtre) ---
        SendKeys_DecocherPremierItem
'   --- Petit délai pour laisser Excel prendre le focus
        Application.Wait Now + TimeValue("0:00:01") ' Un Essaie non concluant !
'   --- SendKeys_DecocherTout_CocherPremier (du Filtre) ---
        SendKeys_DecocherTout_CocherPremier
End Sub

le code VBA Fonctionne pas a cause de l'enchainement à la suite
ListeFiltreTest
Code: 
Sub ListeFiltreTest()
' LireValeursFiltre
  Dim ws As Worksheet
  Dim f As AutoFilter
  Dim filtre As Filter
  Dim arr As Variant
'
    Set ws = ActiveSheet
'
' Le choix de la colonne de La Matrice (Le tableau = La Plage)
' Ici Choix de la colonne 1
    Dim Colonne As Integer ' Choix de la colonne ici la colonne 1
        Colonne = 1
'
    Dim Critére As Range
    Set Critére = ws.Cells(1, 1)
        Critére.Select
'
' Activer le filtre si ce n'est pas déjà fait
    If ws.AutoFilterMode = True Then
'   --- SendKeys_DecocherPremierItem (du Filtre) ---
        SendKeys_DecocherPremierItem
'           --- Argument = strictement Différent de l'argument.
                StockTableau ws, f, filtre, arr, Colonne
                arr(UBound(arr)) = "Vide"
                ReDim Preserve arr(1 To UBound(arr) + 1)
'           --- SendKeys_DecocherTout_CocherPremier (du Filtre) ---
                 SendKeys_DecocherTout_CocherPremier
                 StockTableau ws, f, filtre, arr, Colonne
'           --- Désactiver le filtre si nécessaire ---
                'ws.AutoFilterMode = False
      End If
     ' Transformer en chaîne, supprimer "=", puis recréer le tableau
    arr = Split(Replace(Join(arr, "|"), "=", ""), "|")
    MsgBox Join(arr, vbCrLf), vbInformation, "Contenu du tableau"
End Sub
'
' ==================================================================================================
'
Private Sub StockTableau(ByVal ws As Worksheet, ByVal f As AutoFilter, ByVal filtre As Filter, ByRef arr As Variant, ByRef Colonne As Integer)
    Set f = ws.AutoFilter
    If Not f Is Nothing Then
        Set filtre = f.Filters(Colonne) ' Exemple : première colonne filtrée : f.Filters(1)
        If filtre.On Then
            ' Criteria1
                'Debug.Print "Critère appliqué : " & "filtre.Criteria1"
            ' --- Charger dans un tableau ---
                    If IsArray(arr) Then
                        If UBound(arr) > 0 Then
                            'x = True
                            arr(UBound(arr)) = filtre.Criteria1
                        Else
                            'x = False
                        End If
                    Else
                        'MsgBox "Tableau vide"
                        arr = filtre.Criteria1
                    End If
            ' Criteria2
                If filtre.Operator = xlOr Then
                    'Debug.Print "OU Critère2 : " & filtre.Criteria2
                End If
        End If
    End If
End Sub
'
' ==================================================================================================
'
' SendKeys – décocher seulement le premier item après “Sélectionner tout”
Sub SendKeys_DecocherPremierItem()
' Si le filtre est actif, le désactive pour repartir propre
    If ActiveSheet.AutoFilterMode Then
        On Error Resume Next ' en cas où aucun filtre appliqué
        ActiveSheet.ShowAllData
        On Error GoTo 0
    End If
 
    [A1].Select ' A modifier par la suite = Critére.Select
    If Not ActiveCell Is Nothing Then
        Dim sh As Object
        Set sh = CreateObject("WScript.Shell")
  
        ' Ouvre le menu AutoFilter
        sh.SendKeys "%{DOWN}", True
    
        ' Descend sur le premier item après "Sélectionner tout"
        sh.SendKeys "{DOWN 9}", True ' premier item
        sh.SendKeys " ", True        ' décocher le premier item
    
        ' Valide et ferme le menu
        sh.SendKeys "{ENTER}", True
    End If
End Sub

' SendKeys – décocher tout et cocher le premier item
 Sub SendKeys_DecocherTout_CocherPremier()
 ' Si le filtre est actif, le désactive pour repartir propre
    If ActiveSheet.AutoFilterMode Then
        On Error Resume Next ' en cas où aucun filtre appliqué
        ActiveSheet.ShowAllData
        On Error GoTo 0
    End If
 
    [A1].Select ' A modifier par la suite = Critére.Select
    If Not ActiveCell Is Nothing Then
        Dim sh As Object
        Set sh = CreateObject("WScript.Shell")
  
        ' Ouvre le menu AutoFilter
        sh.SendKeys "%{DOWN}", True
    
        ' Descend sur "Sélectionner tout" et décoche
        sh.SendKeys "{DOWN 8}", True
        sh.SendKeys " ", True ' décocher tout
    
        ' Descend sur le premier item et coche
        sh.SendKeys "{DOWN}", True  ' premier item
        sh.SendKeys " ", True       ' coche
    
        ' Valide et ferme le menu
        sh.SendKeys "{ENTER}", True
        End If
End Sub
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Salut,
Laurent c'est un peu risqué ce que tu fais car cela dépend de la version d'Excel utilisée.
Par exemple chez moi ton code envoie les sendkeys dans la fenêtre VBE , il faut que je mette :
VB: 
     ActiveSheet.Range("A1").Select
    ' Pause courte pour que Excel ait le focus
    Application.Wait Now + TimeValue("0:00:01")
pour que cela fonctionne. Ensuite je n'ai pas le même nombre de Down à faire pour descendre sur le premier item après "Sélectionner tout" Chez moi c'est 10 pas 9
Et un autre point qui peut expliquer ton problème d'enchaînement , le menu que l'on ouvre est modal donc normalement ça bloque le VBA quand il est ouvert.

[EDIT] J'ai essayé la procédure StockTableau sur mon tableau de 250000 éléments, cela semble limité à 10000 éléments et d'ailleurs dans le menu popup c'est écrit en bas : Les éléments ne s'affichent pas tous


StockTableau.png


LimiteSelection.png


Nullosse
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Question Question
Microsoft 365 récupérer des valeurs après un filtre en VBA (pour envoyer des emails)
Réponses
6
Affichages
187
aurejotrail
A
S
  • Résolu(e)
XL 2016 Récupération valeurs cellules lignes autre onglet
Réponses
11
Affichages
95
safranien
S
H
  • Question Question
XL 2010 [RESOLU] recuperer ancien enregistrement excel
2
Réponses
19
Affichages
853
TooFatBoy
TooFatBoy
S
  • Question Question
XL pour MAC récupérer les valeurs d’une plage colonne continue à partir d’une plage discontinue.
Réponses
12
Affichages
530
sergio_bzh
S
Usine à gaz
  • Question Question
Autres Sans supprimer les classeurs : est-il possible de les renommer en supprimant les " - copie" en fin du noms de mes classeurs ?
Réponses
13
Affichages
428
job75
job75
S
  • Question Question
Microsoft 365 Tableaux Structurées : récupérer des données uniques pour consolider un bilan
Réponses
4
Affichages
339
vgendron
vgendron
M
  • Question Question
Microsoft 365 Mon TCD ne prend pas en compte le filtre de la table auquel il est lié.
Réponses
3
Affichages
181
chris
chris
S
  • Question Question
Microsoft 365 Trouver les correspondances de mots entre deux listes
2
Réponses
26
Affichages
719
Sylvaing
S
P
  • Question Question
XL 2019 Macro VBA appliquer un filtre lors d'une importation de données
Réponses
1
Affichages
374
fanch55
fanch55
P
  • Question Question
XL 2016 VBA Appliquer un filtre sur mes données importées
Réponses
4
Affichages
495
sousou
sousou
P
  • Résolu(e)
XL 2021 Requête API - VBA Excel - Parse JSON
Réponses
2
Affichages
476
picc
P
A
  • Résolu(e)
XL 2019 VBA newbie
4 5 6
Réponses
80
Affichages
3 K
apocalypse
A
D
  • Résolu(e)
Microsoft 365 Assistance pour optimisation d'un code VBA qui ne fonctionne pas comme souhaité
2
Réponses
21
Affichages
682
desto
D
M
  • Question Question
Microsoft 365 Fonction si et rechercheX
Réponses
1
Affichages
218
Aya_flo
A
A
  • Question Question
XL 2010 Problème ou alternative à SOMPRODUCT en VBA
Réponses
14
Affichages
552
bruno lemaire
B
S
  • Résolu(e)
Microsoft 365 Afficher la référence de colonne d'un entête
Réponses
3
Affichages
235
Cousinhub
Cousinhub
P
  • Question Question
XL 2016 Macro VBA remplissage tableau de synthèse % déchet ligne de production
Réponses
4
Affichages
297
vgendron
vgendron
N
  • Résolu(e)
Microsoft 365 Supprimer de la liste d'une Combo les données déjà présentes dans une colonne d'un TS
2
Réponses
18
Affichages
909
NONO14
N
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
562
JJ69
J
S
  • Question Question
XL 2019 Fichier de tirage au sort sans doublons avec valeurs en plus
Réponses
1
Affichages
361
sylvanu
sylvanu
Retour