Récupérer tous les critères de filtre dans un tableau VBA

Bonjour,

Je bloque depuis quelques jours sur la récupération de tous les critères de filtre d'une colonne dans un tableau VBA. Je m'explique, j'aimerais obtenir un tableau nommé Array1 contenant tous les critères de filtres possibles de la colonne A et un autre tableau Array2 contenant tous les critères de filtres possibles de la colonne C. Pourriez-vous m'aider à résoudre ce problème svp ?

J'ai testé plusieurs choses comme celle-ci mais rien ne marche :

Sub Recup()
'Création du tableau contenant tous les critères de filtre de la colonne A
Dim Array1() As Variant
Dim f As Filter, i As Integer
For i = 1 To ActiveSheet.AutoFilter.Filters.Count
ReDim Preserve Array1(1 To i)
Array1(i) = ActiveSheet.AutoFilter.Filters(1)
Next i
End Sub

Je vous remercie d'avance pour votre aide !

Léa

Bonjour,

A priori, il faut remplacer le 1 par i dans la boucle (sinon, on ne récupère que le premier critère^^) :

Sub Recup()
'Création du tableau contenant tous les critères de filtre de la colonne A
Dim Array1() As Variant
Dim f As Filter, i As Integer
For i = 1 To ActiveSheet.AutoFilter.Filters.Count
ReDim Preserve Array1(1 To i)
Array1(i) = ActiveSheet.AutoFilter.Filters(i) '<<<< ICI
Next i
End Sub

PS : Pour poster du code, vous pouvez utiliser les balises </> du ruban d'icônes

Cdlt,

Je te remercie pour ta réponse mais ça ne fonctionne pas non plus. J'ai un message d'erreur du type "Propriété ou méthode non gérée par cet objet" pour la ligne que tu m'as dit de modifier. Aussi, je pensais que Filters(1) me récupérait les critères de filtres de la colonne A ?

Désolé, j'ai juste adapté votre code, sans faire attention...

Je viens de regarder microsoftdocs car je n'ai jamais essayé de récupérer les critères de filtres...

Voici un nouvel essai :

Sub Recup()
'Création du tableau contenant tous les critères de filtre de la colonne A
with ActiveSheet.AutoFilter.Filters
    redim tf(1 to 1000, 1 to .count)
    For i = 1 To .Count
        t = .items(i).criteria1 '<<< doute
        for j = lbound(t) to ubound(t)
            tf(j + 1, i) = t(j) '<<< doute
        next j
    Next i
end with
End Sub

Cdlt,

Ça ne fonctionne pas non plus... Merci quand même !

Sinon je pensais qu'il serait peut être possible de parcourir chaque cellule de la colonne A et d'ajouter la valeur de la cellule au tableau Array1 si elle n'est pas déjà contenue dedans. J'ai essayé le code suivant mais là encore ça ne fonctionne pas :

Sub Filtrage()
    'Création du tableau contenant tous les critères de filtre de la colonne A
    Set Plage = Range("A" & Cells(Rows.Count, 1).End(xlUp).Row)
    For Each Cell In Plage
        Estdans = Application.Match(Cell.Value, Array1, 0)
        If Estdans = False Then
            i = i + 1
            ReDim Preserve Array1(1 To i)
            Array1(i) = Cell.Value
        End If
    Next Cell
End Sub

J'ai également essayé quelque chose comme ça mais ça ne fonctionne toujours pas :

Sub Recup()
Dim Array1() As Variant
Set Plage = Range("A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each Cell in Plage
      If Cell.Value Not In Array1 Then
            Redim Preserve Array1(UBound(Array1)+1)
            Array1(UBound(Array1))=Cell.Value
      End If
Next Cell
End Sub

Re,

J'ai fait des essais, ce code fonctionne :

Sub Recup()
'Création du tableau contenant tous les critères de filtre de la colonne A
Dim f As Filter, tf(), i&, t, j&, maxdim&

maxdim = 1
With ActiveSheet
    ReDim tf(1 To 1000, 1 To .AutoFilter.Filters.Count)
    Set fs = .AutoFilter.Filters
    For Each f In .AutoFilter.Filters
        i = i + 1
        If f.On Then
            t = f.Criteria1
            If IsArray(t) Then
                For j = LBound(t) To UBound(t)
                    tf(j, i) = "'" & t(j)
                Next j
                maxdim = Application.Max(maxdim, j - 1)
            Else
                tf(1, i) = "'" & t
            End If
        End If
    Next
    .Range("A40").Resize(maxdim, UBound(tf, 2)) = tf
End With

End Sub

Cdlt,

Edit : Petite MAJ

Je vous remercie beaucoup ! En revanche j'ai vraiment du mal à comprendre votre code :(

Désolé, j'avais commenté, puis j'ai écrasé le code avec un nouveau non commenté .

En voici un autre (avec un fichier cette fois) :

Sub Recup()
'Création du tableau contenant tous les critères de filtre de la colonne A
Dim tf(), i&, t, j&, maxdim&

maxdim = 1 'inititalisation (du nombre de lignes à restituer)
With ActiveSheet 'avec feuille active
    With .Range("Crit") 'avec tableau "Crit" <<< tableau structuré à créer en amont !
        If .Rows.Count > 1 Then .Delete Else .Clear 'si nb lignes > 1, on supprime, sinon on efface le contenu
    End With
    If .AutoFilter Is Nothing Then Exit Sub 's'il n'y a pas de filtre, on sort
    With .AutoFilter 'avec la zone de filtre
        If .FilterMode = False Then Exit Sub 's'il le filtre n'est pas appliqué, on sort
        ReDim tf(1 To 1000, 1 To .Filters.Count) 'redimension du tableau (en mémoire) qui stockera les critères
        For i = 1 To .Filters.Count 'pour chaque colonne du filtre
            If .Filters(i).On Then 'si la colonne en cours a un filtre actif
                t = .Filters(i).Criteria1 't recoit les critères
                If IsArray(t) Then 'si t est un tableau (cad qu'il y a plusieurs critères sur la mm colonne)
                    For j = LBound(t) To UBound(t) 'pour chaque critère
                        tf(j, i) = "'" & t(j) 'alimentation des lignes de la colonne en cours (l'apostrophe sert à mieux restituer les critères)
                    Next j
                    maxdim = Application.Max(maxdim, j - 1) 'maj du nb de lignes à restituer (max entre l'ancien max et le nb de critères en cours)
                Else
                    tf(1, i) = "'" & t 's'il n'y a qu'une seule valeur
                End If
            End If
        Next
    End With
    .Range("Crit").Resize(maxdim, UBound(tf, 2)) = tf 'restitution critères dans "Crit", "retaillé" à maxdim lignes
End With

End Sub

N'hésitez pas si vous avez des questions !

La macro s'exécute grâce à un double clic sur la feuille !

Cdlt,