Sub ListeFiltre()
' LireValeursFiltre
Dim ws As Worksheet
Dim f As AutoFilter
Dim filtre As Filter
Dim arr As Variant
'
Set ws = ActiveSheet
'
' La Matrice (Le tableau = La Plage)
Dim premiereCellule As Range
Set premiereCellule = ActiveCell.CurrentRegion.Cells(1)
'
' 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 = ActiveCell.Column - premiereCellule.Column + 1
'
' Choix le premier critére de du Filtre
' En rapport avec les deux fonction de récupération :
' FiltrerDonnees1 & FiltrerDonnees2
Dim Critére As String
premiereCellule(1, 1).Select
Critére = premiereCellule(2, 1)
'
' Activer le filtre si ce n'est pas déjà fait
If ws.AutoFilterMode = False Then
ws.Rows(1).AutoFilter
' --- Décocher la première valeur (du Filtre) ---
' --- Argument = strictement Différent de l'argument.
FiltrerDonnees1 Critére, premiereCellule, Colonne
StockTableau ws, f, filtre, arr
On Error Resume Next
arr(UBound(arr)) = "Vide"
ReDim Preserve arr(1 To UBound(arr) + 1)
On Error GoTo 0
' --- Cocher la première valeur (du Filtre) ---
' --- Argument = strictement l'argument.
FiltrerDonnees2 Critére, premiereCellule, Colonne
StockTableau ws, f, filtre, arr
' --- Désactiver le filtre si nécessaire ---
ws.AutoFilterMode = False
ElseIf ws.AutoFilterMode = True Then
Set f = ws.AutoFilter
Set filtre = f.Filters(Colonne)
If filtre.On Then
' --- Décocher la première valeur (du Filtre) ---
' --- Argument = strictement Différent de l'argument.
StockTableau ws, f, filtre, arr
arr(UBound(arr)) = "Vide"
ReDim Preserve arr(1 To UBound(arr) + 1)
' --- Cocher la première valeur (du Filtre) ---
' --- Argument = strictement l'argument.
FiltrerDonnees2 Critére, premiereCellule, Colonne
StockTableau ws, f, filtre, arr
' --- Désactiver le filtre si nécessaire ---
ws.AutoFilterMode = False
End If
End If
On Error Resume Next
' Transformer en chaîne, supprimer "=", puis recréer le tableau
arr = Split(Replace(Join(arr, "|"), "=", ""), "|")
MsgBox Join(arr, vbCrLf), vbInformation, "Contenu du tableau"
On Error GoTo 0
End Sub
'
' ==================================================================================================
'
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
'
' ==================================================================================================
'
Sub FiltrerDonnees1(ByRef Critére As String, ByVal premiereCellule As Range, ByRef Colonne As Integer)
' Argument = strictement Différent de l'argument.
premiereCellule.AutoFilter
premiereCellule.AutoFilter Field:=Colonne, Criteria1:="<>" & Critére
End Sub
'
Sub FiltrerDonnees2(ByRef Critére As String, ByVal premiereCellule As Range, ByRef Colonne As Integer)
' Argument = strictement l'argument.
premiereCellule.AutoFilter
premiereCellule.AutoFilter Field:=Colonne, Criteria1:=Critére
End Sub