XL 2013 Récupérer le critère d'un filtre automatique

[BenHarber]

Bonjour le Forum,
cf. en PJ un exemple de fichier avec des données "formatées tableau" et une macro évènementielle qui se déclenche au recalcul de la feuille : celle-ci détecte si les différents filtres sont activés ou non.
Pour chaque colonne ayant un filtre activé, je souhaiterais savoir s'il est possible de récupérer dans une variable le ou les critères sélectionnés ? Et si oui, comment faire ?
Pour info. le fichier que je traite compte en réalité plus de 100 000 lignes.

Merci d'avance pour vos idées et suggestions qui sont toujours les bienvenue !

BH

 

[BOISGONTIER]

Bonjour,

http://boisgontierjacques.free.fr/fichiers/Filtre/FiltreAutoFonctionPerso.xls

Boisgontier

 

[BenHarber]

Boisgontier,
Merci pour ta solution : c'est exactement le résultat que je souhaite obtenir.
Seulement, pour pouvoir la mettre en œuvre, c'est une autre paire de manches....car mes connaissances en VBA ne sont pas aussi poussées que les tiennes : je vais regarder tout ça et te poserai peut-être quelques questions complémentaires...
Merci encore !
BH

 

[BOISGONTIER]

Il faut copier/coller ces fonctions dans un module (Insertion/Module):

Function ChampActif(c)
  Application.Volatile
  ChampActif = Sheets(Application.Caller.Parent.Name).AutoFilter.Filters.Item(c.Column - Sheets(Application.Caller.Parent.Name).Range("_FilterDataBase").Column + 1).On
End Function

Function FiltreCol(Champ As Range, TitreChamp As Range)
  Application.Volatile
  If Not ChampActif(TitreChamp) Then FiltreCol = "": Exit Function

  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
  For Each c In Champ
    If Not c.EntireRow.Hidden And c.Value <> "" Then d(c.Value) = c.Value
  Next c
  a = d.items
  If IsDate(Champ(1)) Then
    If d.Count = 1 Then
       FiltreCol = TitreChamp & ":" & Format(a(0), "dd/mm/yyyy")
    Else
      mini = a(0): maxi = a(0)
      For i = LBound(a) To UBound(a)
        If a(i) < mini Then mini = a(i)
        If a(i) > maxi Then maxi = a(i)
      Next i
      FiltreCol = TitreChamp & ":" & "> " & mini & " et < " & maxi
    End If
  Else
    If IsNumeric(Champ(1)) Then
      If d.Count = 1 Then
        FiltreCol = TitreChamp & ":" & a(0): Exit Function
      Else
        mini = a(0): maxi = a(0)
        For i = LBound(a) To UBound(a)
          If a(i) < mini Then mini = a(i)
          If a(i) > maxi Then maxi = a(i)
        Next i
        FiltreCol = TitreChamp & ":" & "> " & mini & " et < " & maxi: Exit Function
      End If
     Else
       FiltreCol = TitreChamp & ": " & Join(a, ",")
      ' FiltreCol = Join(a, " ")
     End If
  End If
End Function

Boisgontier

 

[BenHarber]

OK, nickel : j'y vois plus clair !
1000 mercis pour cette astuce.
BH