Mémoriser un dictionnaire dans le gestionnaire de noms

Question

Afin de contourner l'absence d'event lors de la modification d'un autofiltre d'un tableau structuré, je crée dans la feuille une cellule de type SOUS.TOTAL(3,[A:A]) et je déclenche avec Worksheet_calculate.

Le déclencheur étant maintenant actif, je détermine sous quelles conditions ma macro se lance : modification du nombre de ligne filtrées (le plus évident), index de la première ou de la dernière ligne visible (des fois que la modif de mes filtres ait retourné la même quantité de visibles, ou bien lorsque j'applique simplement un tri), ou enfin modification de l'ordre des valeurs d'une colonne 27 (et ça tombe bien il s'agit de clés primaires donc uniques).

Je vais donc utiliser le gestionnaire de nom afin de garder en mémoire ces variables (qte de lignes visible, index de 1ere et dernière ligne, dictionnaire des clés primaire) telles qu'elles étaient avant le nouveau filtrage.

Question : peut on garder en mémoire un dictionnaire ? Ou bien seulement un array ?

Private Sub Worksheet_Calculate()
'*** Objectif : Pour palier à l'absence d'évènement lors de la modification
'*** d'un filtre de la table, il s'agit de conditionner le déclenchement de la
'*** fonction Aerial s'il existe une différence entre les lignes visibles
'*** précédemment et celles avec l'application du nouveau filtre.
'*** Utilisation du gestionnaire de noms pour stockage du dictionnaire
'*** gardant en mémoire les précédentes lignes visibles.
'*** On utilise l'évènement calculate avec une cellule calculant un sous.total
'*** et déclenchant donc l'évènement.
With Application:
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
    'DisplayAlerts = False
End With

Dim lo As ListObject
Dim nbNOW%, frstrowNOW%, lastrowNOW%, j%
Dim dict As Object
Dim Cel, Rng, N
Dim exist1, exist2, exist3, existD

    Set lo = ListObjects("Tbl_encours")
    frstrowNOW = Range(Cells(lo.DataBodyRange(1).Row, lo.ListColumns(1).Index), Cells(Rows.Count, lo.ListColumns(1).Index).End(xlUp)).SpecialCells(xlCellTypeVisible).Row
    lastrowNOW = Cells(lo.HeaderRowRange(1).Row, lo.ListColumns(1).Index).End(xlDown).Row
    nbNOW = QtevisibleListObject(lo, 1) 'fonction perso
    If nbNOW = 0 Then Exit Sub

    'dictionnaire des # visibles dans encours
    Set dict = CreateObject("Scripting.Dictionary")
    Rng = Range(Cells(frstrowNOW, lo.ListColumns(27).Index), Cells(lastrowNOW, lo.ListColumns(27).Index)).SpecialCells(xlCellTypeVisible)
    For Each Cel In Rng
        dict.Add Cel, ""
    Next Cel

    'check si existe mémoire
    For Each N In ThisWorkbook.Names
        If N.Name = "mémoNB" Then exist1 = True
        If N.Name = "mémoFRSTROW" Then exist2 = True
        If N.Name = "mémoLASTROW" Then exist3 = True
        If N.Name = "mémoDICO" Then existD = True
    Next N
    'sinon enregistre
    If Not exist1 Then ThisWorkbook.Names.Add Name:="mémoNB", RefersTo:="=" & nbNOW
    If Not exist2 Then ThisWorkbook.Names.Add Name:="mémoFRSTROW", RefersTo:="=" & frstrowNOW
    If Not exist3 Then ThisWorkbook.Names.Add Name:="mémoLASTROW", RefersTo:="=" & lastrowNOW
    If Not existD Then ThisWorkbook.Names.Add Name:="mémoDICO", RefersTo:=dict
    'si actuel <> mémoire alors déclenche
    If nbNOW <> [mémoNB] Or frstrowNOW <> [mémoFRSTROW] Or lastrowNOW <> [mémoLASTROW] Then
        Call Aerial
    Else
        For j = 0 To dict.Count
            If dict.keys(j) <> [mémoDICO].keys(j) Then
                Call Aerial
                Exit For
            End If
        Next j
    End If
    'actualise la mémoire
    With ThisWorkbook.Names
        .Add Name:="mémoNB", RefersTo:="=" & nbNOW
        .Add Name:="mémoFRSTROW", RefersTo:="=" & frstrowNOW
        .Add Name:="mémoLASTROW", RefersTo:="=" & lastrowNOW
        .Add Name:="mémoDICO", RefersTo:=dict
    End With

With Application:
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub

Merci aux passionnés de tableurs

mafraise · Accepted Answer

Plutôt que vouloir sauvegarder dans des noms définis diverses valeurs liées au filtrage d'un tableau structuré (avec l'impossibilité de sauvegarder un dictionary), j'ai pensé à sauver via un nom défini la liste des numéros de lignes affichées par le filtre. Cela fonctionnait bien mais je me suis heurté à la taille maximum d'un string sauvegardé via un "RefersTo"; Après des tests, il semblerait que cette taille max soit de 255 caractères. Il est évident que cette limite ridiculement basse rend impossible cette solution. J'ai donc changé mon fusil d’épaule et voici la méthode que j'ai employée : Si elle n'existe pas, création d'une feuille auxiliaire qui sera masquée (même très masquée). Cette feuille servira à sauvegarder dans sa première colonne la liste des numéros des lignes visibles du filtrage. Si le filtrage est modifié, cette feuille comportera donc les numéros des lignes affichées par le précédent filtrage. Dès qu'une modification potentielle du filtrage est détectée (via la cellule G1) : on récupère la liste List-1 des numéros des lignes affichées par le précédent filtrage (lecture depuis la feuille auxil.) on dresse la liste List-2 de l'actuel filtrage on sauvegarde la liste List-2 de ces numéros sur la feuille auxil. on compare les deux listes List-1 et List-2 si elles sont égales alors le nouveau filtre n'a pas modifié le résultat. Si les listes diffèrent, ne serait-ce que d'un seul élément, alors le nouveau filtre a modifié le résultat du précédent filtre Le code est dans le module de la feuille "Feuil1". Le code est commenté en espérant que les commentaires soient compréhensibles et utiles. Private Sub Worksheet_Calculate() Const NomFauxil = "Auxil-Z1Ab9Pq3Mc2Du0" Dim wksAuxil As Worksheet, lsto As ListObject, x, n&, tOld, tNew, nNew&, i&, FiltreModif As Boolean ' pour éviter les perturbations et accélérer le traitement Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual: Application.EnableEvents = False ' création, le cas échéant, de la feuille auxiliaire de nom NomFauxil (feuille très masquée) ' on affecte à wksAuxil la feuille auxiliaire. Si elle n'existe pas alors une erreur est levée qu'on va traiter On Error Resume Next: Set wksAuxil = ThisWorkbook.Worksheets(NomFauxil) On Error GoTo err001 ' par la suite si une erreur survient on passera en fin de code If wksAuxil Is Nothing Then ' la feuille auxiliaire n'existe pas, on la crée et on la nomme Set wksAuxil = ThisWorkbook.Worksheets.Add(before:=ThisWorkbook.Sheets(1)) wksAuxil.Name = NomFauxil End If Me.Select: wksAuxil.Visible = xlSheetVeryHidden ' selection de la feuille appelante & masquage de la feuille aux. ' on lit la première colonne de la feuille aux. (ie N° des lignes visibles de l'ancien filtrage + 2 lignes) tOld = wksAuxil.Range("a1").Resize(Application.Count(wksAuxil.Columns(1)) + 2, 1) With Me Set lsto = .&#91;a1&#93;.ListObject ' tableau structuré en cellule A1 ReDim tNew(1 To lsto.Range.Rows.Count, 1 To 1) ' tableau max des numéros de lignes affichées par le filtre For Each x In lsto.Range.Columns(1).Cells ' pour chaque cellule du tableau structuré-colonne 1, on regarde si ' la ligne est masquée ou non. Si oui alors on ajoute le N° ' dans le tableau tNew et on incrémente le nombre n de lignes If Not x.EntireRow.Hidden Then n = n + 1: tNew(n, 1) = x.Row Next ' on efface la colonne 1 de la feuille aux. Puis on tranfère tNew dans cette colonne. wksAuxil.Columns(1).Clear: wksAuxil.&#91;a1&#93;.Resize(UBound(tNew)) = tNew ' on relit ce tableau mais avec la taille qu'on désire (c'est à dire n+2) tNew = wksAuxil.&#91;a1&#93;.Resize(n + 2, 1) End With ' à ce stade, nous avons le tableau des N° de lignes du filtre précédent et le tableau ' des N° du filtre actuel. On va pourvoir les comparer FiltreModif = False ' par défaut, pas de changement au niveau du nouveau filtre If UBound(tOld) &lt;&gt; UBound(tNew) Then ' si le nombre de lignes des deux tableaux sont différents FiltreModif = True ' alors les résultats du filtre ont changé Else For i = 1 To UBound(tOld) ' les deux tableaux ont le même nombres de lignes ' on compare les numéros de ligne dans les deux tableaux. S'ils sont différents, ' c'est que le résultat du nouveau filtrage a modifié les résultats du filtre précédent ' on le note dans FiltreModif et on interrompt la boucle If tOld(i, 1) &lt;&gt; tNew(i, 1) Then FiltreModif = True: Exit For Next i End If 'on affiche le résultat MsgBox "Le résultat du filtrage " & IIf(FiltreModif, "a changé.", "est resté le même."), vbInformation err001: ' remettre le calcul en automatique et activer à nouveau l'interception des èvènements par Excel Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic: Application.EnableEvents = True End Sub...

patrickT · Answer

Dict est un object je ne pense pas que tu puisse mettre autre chose qu'une formule ou address ou string dans un name tu pourrais par contre mettre le join(dict.keys,",") et pour la lecture utiliser un split du refersto en supprimant le "="...

thev · Answer

Ce que vous pouvez stocker dans un nom, c'est une plage ou un ensemble de plages discontinues. D'ailleurs dans un filtre, vous récoltez souvent des plages discontinues, ce que ne vous gérez pas dans votre code : "Rng" ne vous donne que la première plage si ces dernières sont discontinues...

mafraise · Answer

Re tomato , Oui, il existe au moins une manière de le faire : Dans Module1, on a déclaré deux variables publiques avec : Public lstoTS As ListObject, dicOld As Object . LstoTS est le tableau structuré et dicOld est le dictionary des numéros de lignes visibles du tableau structuré (ligne des en-têtes comprises). Les numéros de ligne sont les numéros au sein du tableau structuré et non pas les numéros de la feuille de calcul. La ligne des en-têtes a donc le numéro 1. Quand le classeur s'ouvre, on crée le dictionary dicoOld avec la fonction Function DicoDesLignesVisibles(xlsto As ListObject) As Object dont le code se trouve dans Module1 Quand la feuille se recalcule, on crée un dictionary dicNew pour y insérer tous les numéros des lignes visibles du filtre courant. On dispose des deux dictionary : l'ancien dicOld et le nouveau dicNew . On va pouvoir les comparer. Si les deux dictionary contiennent exactement les mêmes clefs alors le filtre courant n'a rien modifié. S'il y a au moins une clef qui n'est pas la même alors le nouveau filtre a modifié les résultats du filtre précédent. En outre, on n'oublie pas d'affecter dicNew à dicOld pour préparer une nouvelle future comparaison. dicOld est "vivant" tant que le classeur reste ouvert Attention ! L'objet dictionary n'est pas disponible sur MAC. patrickT (que je salue ) a créé, me semble-t-il, une structure analogue au dictionary pour les utilisateurs de MAC. Les codes sont commentés et se trouvent répartis dans le module de ThisWorkbook, dans le module de Feuil1 et dans Module1. nota : on doit pouvoir remplacer les dictionary par de simples tableaux en mémoire ce qui rendrait le code compatible avec le monde MAC. On pourrait aussi n'utiliser que les adresses des plages visibles à la place de la boucle sur les lignes du TS. On verra ça un peu plus tard...

mafraise · Answer

Re, Une dernière version compatible MAC qui s'appuie sur des ranges. Pour un filtre donnée, le range des plages affichées est trouvé en utilisant simplement la méthode SpecialCells appliquée à la première colonne du tableau structuré. En comparant le range du filtre précédent (déclaré au niveau Module1) au range du filtre actuel, on voit très facilement si les résultats des deux filtres diffèrent ou pas. La comparaison se fait par la comparaison des adresses des plages . Le code est concis (il est commenté dans le classeur joint). . Code dans Module1 : Public lstoTS As ListObject, rgOld As Object . Code dans le module de ThisWorkbook : Private Sub Workbook_Open() Set lstoTS = Sheets("Feuil1").&#91;a1&#93;.ListObject Set rgOld = lstoTS.Range.Columns(1).SpecialCells(xlCellTypeVisible) End Sub . Code dans le module de la feuille "Feuil1" : Private Sub Worksheet_Calculate() Dim rgNew As Range, i&, xarea As Range, FiltrageDiff As Boolean Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual: Application.EnableEvents = False On Error GoTo ERRFIN Set rgNew = lstoTS.Range.Columns(1).SpecialCells(xlCellTypeVisible) If rgNew.Areas.Count &lt;&gt; rgOld.Areas.Count Then FiltrageDiff = True Else For i = 1 To rgOld.Areas.Count If rgOld.Areas(i).Address &lt;&gt; rgNew.Areas(i).Address Then FiltrageDiff = True: Exit For Next i End If Set rgOld = rgNew MsgBox "Le résultat du filtrage " & IIf(FiltrageDiff, "a changé.", "est resté le même."), vbInformation ERRFIN: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic: Application.EnableEvents = True End Sub...