XL 2010 classer clé dico dans un ordre prédéfini

[cathodique]

Bonjour,

Je voudrais classer les clés d'un dictionnaire dans ordre prédéfini. Un tri dans les 2 sens (croisant/décroissant) ne répondent à mes attentes.

Option Explicit
Sub Classer()
Dim tb, i As Long, d As Object
Set d = CreateObject("scripting.dictionary")
tb = [Table].Value

For i = 1 To UBound(tb)
d(tb(i, 3)) = ""
Next i
End Sub

En fait, je voudrais faire 2 choses:
1 - ma bd ne cesse de s'allonger, du coup l'ordre des clés change. les clés en questions sont des abréviations. Actuellement, une abréviation est absente de ma bd, mais il faut la prendre en compte.
Après avoir, compléter le dictionnaire par code, je voudrais classer les clés suivant cet ordre: Cd, Fa, Ad, Ch, Rt (abréviation non présente actuellement.

2 - Dans un deuxième temps, remplacer ces abréviations par leur signification pour éditer un rapport
Cd=Entrée - Fa= famille - Ad=Sortie - Ch=Changement - Rt= Retour

En vous remerciant

 

[mapomme]

Bonjour @cathodique ,

Je ne comprend pas !

Vous utilisez un dictionnaire qui répertorie les catégories de la source : OK
Vous voulez classer ces catégories selon un ordre prédéfini qu'un code ne peut pas deviner. Donc il faut à un moment donné indiquer les catégories selon l'ordre que vous désirez.
Cela signifie que préalablement à l'exécution de la macro, vous connaissez :

• toutes les catégories possibles
• et leur ordre souhaité d'apparition
• et que vous avez indiqué cela quelque part (sur une feuille, en constante dans la macro, etc)

Je ne vois pas l'utilité de parcourir la source pour établir la liste des catégories puisque vous la connaissez par avance et qu'en plus vous en avez fourni le classement ?

 

[Dranreb]

Personnellement je préfère classer avant de regrouper.
Mais c'est bien parce que j'ai l'habitude de gérer les tests dits de ruptures de séquence dans des boucles imbriquées. Cela dit j'ai une Function Gigogne vous en affranchit totalement, vu qu'elle les fait tous à votre place et range le résultat dans des collections imbriquées. J'ai soumis ce matin un classeur .xlsm précurseur d'un .xlam qui contient ces outils.
Hé, mais … j'ai déjà une ribambelle de classeurs GigogneCathodiqueX.xlsm !
Quand est-ce que vous allez vous mettre à apprendre à utiliser cette fonction ?

 

[cathodique]

Merci beaucoup. Exactement le résultat escompté.

Hé, mais … j'ai déjà une ribambelle de classeurs GigogneCathodiqueX.xlsm !

Ah!!! mes sujets t'inspirent de nouveaux ou complément de code. J'en suis ravi.

Quand est-ce que vous allez vous mettre à apprendre à utiliser cette fonction ?

Quand j'aurai un peu plus de temps, quand je comprendrai un minimum de tes "oeuvres".
En tout cas, tu as le mérite d'être très fort. En toute sincérité, je t'envie un peu ta maîtrise du codage.

@mapomme : Depuis un moment, je me suis fixé comme règle de ne répondre qu'aux participants qui proposent une solution.

@klin89 : Merci beaucoup pour ta suggestion depuis ton téléphone.

Bon dimanche

 

[mapomme]

Re,

Bon après avoir lu le message de @Dranreb que je salue , j'ai compris la demande.
Voici un code (dans module1) qui devrait le faire.
les codes absents (ou intiltulés) de la table de référence sont rejeté à la fin du tableau source.

 

[mapomme]

@mapomme : Depuis un moment, je me suis fixé comme règle de ne répondre qu'aux participants qui proposent une solution.

Bon tu n'auras plus l'occasion de répondre à un de mes messages puisqu’il n'y aura plus de message du tout. Ravi de t'avoir connu...

 

[cathodique]

Re,

Bon après avoir lu le message de @Dranreb que je salue , j'ai compris la demande.
Voici un code (dans module1) qui devrait le faire.
les codes absents (ou intiltulés) de la table de référence sont rejeté à la fin du tableau source.

Tu as en partie compris ma demande.
Je ne veux rien modifier à mon tableau.
Je cherche à récupérer les clés dans un ordre prédéterminé (car le tableau s'allonge et du coup les clés sont dans un ordre différent).
Et ensuite, remplacer les abréviations par leur signification. J'en ai juste besoin pour faire l'entête d'un tableau à imprimer.
j'ai commencé par alimenter mon dico dans l'ordre souhaité

d.Add "Cd", Empty
d.Add "Fa", Empty
d.Add "Ad", Empty
d.Add "Ch", Empty
d.Add "Rt", Empty

J'ai voulu suivre la proposition ci-dessous de @klin89 en mp depuis son téléphone

Dans un premier temps, tu parcours ta liste prédéfinie pour déterminer l'ordre des clés dans le dico.
Tu associes l'item à la clé comme ceci :
dico("machin") = Empty

Dans un deuxième temps, tu parcours ton tableau avec la méthode exists pour associer l'item associé à la clé concernée.
Exemple: dico("machin") = "blabla"

Dans un troisième temps, tu parcours ton Dico pour supprimer les clés dont l'item est resté à empty avec la méthode remove du Dico.
Exemple : If IsEmpty dico("machin") then remove la clé, plus trop souvenir de la syntaxe exacte.

sauf que je rame un peu en cette fin de journée.

Merci beaucoup.

 

[Dranreb]

Si vous pensez qu'if vous faudra du temps c'est parce que vous êtes toujours encore resté bloqué sur l'idée d'étudier comment procède la fonction Gigogne pour constituer la collection qu'elle renvoie, ce qui est effectivement une grosse perte de temps, au lieu d'analyser par des espions le contenu d'une telle collection afin d'établir son lien avec les paramètres qui lui ont été spécifiés.

 

[cathodique]

Bon tu n'auras plus l'occasion de répondre à un de mes messages puisqu’il n'y aura plus de message du tout. Ravi de t'avoir connu...

à ta guise. Tu m'as fait une proposition au post#5, je t'ai répondu.
Si tu m'avais demandé plus d'information. je t'aurai répondu.
je t'avoue que j'ai interprété ton post#2 similaire à de la moquerie.
c'est raison pour laquelle, j'ai décidé de ne plus répondre au post qui à mon sens n'apporte rien à la discussion.

 

[cathodique]

Si vous pensez qu'if vous faudra du temps c'est parce que vous êtes toujours encore resté bloqué sur l'idée d'étudier comment procède la fonction Gigogne pour constituer la collection qu'elle renvoie, ce qui est effectivement une grosse perte de temps, au lieu d'analyser par des espions le contenu d'une telle collection afin d'établir son lien avec les paramètres qui lui ont été spécifiés.

Je sincèrement désolé mais je n'ai pas pour le moment de temps pour m'intéresser à tes très efficace code.
Avec mes maigres connaissances tes codes m'impressionnent. Je sais que je ne parviendrai pas à réutiliser tout seul tes modules de services.
Merci.

 

[cathodique]

Pour le partage mon code perfectible, en utilisant la suggestion de @klin89

Option Explicit

Sub Classer()
   Dim tb, i As Long, d As Object, cle
   Set d = CreateObject("scripting.dictionary")
   tb = [Table].Value
   'Cd, Fa, Ad, Ch, Rt
   d.Add "Cd", Empty
   d.Add "Fa", Empty
   d.Add "Ad", Empty
   d.Add "Ch", Empty
   d.Add "Rt", Empty

   For i = 1 To UBound(tb)
      cle = tb(i, 3)
        If d.exists(cle) Then
            ' Ajouter la signification à la clé correspondante
            Select Case cle
                Case "Cd"
                    d(cle) = "Entrée"
                Case "Fa"
                    d(cle) = "Famille"
                Case "Ad"
                    d(cle) = "Sortie"
                Case "Ch"
                    d(cle) = "Changement"
                Case "Rt"
                    d(cle) = "Retour"
            End Select
        End If
   Next i
  
' Supprimer les clés dont la valeur est vide
   For Each cle In d.Keys
      If IsEmpty(d(cle)) Then d.Remove (cle)
   Next

   '    ' Afficher le contenu du dictionnaire final
   Dim message As String
   message = "Dictionnaire d'abréviations :" & vbCrLf
   For Each cle In d.Keys
      message = message & cle & " : " & d(cle) & vbCrLf
   Next cle

   MsgBox message
End Sub

Bonne soirée.

 

[Dranreb]

Je sais que je ne parviendrai pas à réutiliser tout seul tes modules de services.

Qu'est-ce qui pourrait bien vous porter à croire cela ?
Il faudrait essayer au moins. Ce serait instructif de voir où ça bloque. Ça pourrait m'aider à améliorer la feuille d'aide du projet GigIdx.

 

[cathodique]

Qu'est-ce qui pourrait bien vous porter à croire cela ?
Il faudrait essayer au moins. Ce serait instructif de voir où ça bloque. Ça pourrait m'aider à améliorer la feuille d'aide du projet GigIdx.

Mon cher @Dranreb , je t'assure que ce n'est pas de la mauvaise volonté. En ce moment, je n'ai pas vraiment beaucoup de temps. Je t'ai promis que j'essaierai au moins d'apprendre comment utiliser tes différents module de services. Pour l'instant, ce n'est pas possible.

 

[patricktoulon]

re
bonjour
en voilà tout un toin toin pour si peu

Option Explicit

Sub Classer()
    Dim tb, d As Object, k, x, message$
    Set d = CreateObject("scripting.dictionary")
    tb = [Table].Value
    'Cd, Fa, Ad, Ch, Rt
    d.Add "Cd", "Entrée"
    d.Add "Fa", "Famille"
    d.Add "Ad", "Sortie"
    d.Add "Ch", "Changement"
    d.Add "Rt", "Retour"

    For Each k In d.keys
        'x = Application.IfError(Application.Match(k, [Table].Columns(3), 0), 0)'methode 1
        x = Evaluate("COUNTIF(" & [Table].Columns(3).Address & ",""" & k & """)")'methode 2
        If x = 0 Then
            d.Remove (k)
        Else
            message = message & k & " : " & d(k) & vbCrLf
        End If
    Next
    
    message = "Dictionnaire d'abréviations :" & vbCrLf & message
    MsgBox message

End Sub

 

[patricktoulon]

ou simplement avec 2 array synchros

Sub Classer()
    Dim tb, d As Object, i&, message$, abrev, v
    Set d = CreateObject("scripting.dictionary")
    tb = [Table].Value
    abrev = Split("Cd,Fa,Ad,Ch,Rt", ",")
    v = Split("Entrée,Famille,Sortie,Changement,Retour", ",")

    For i = 0 To UBound(abrev)
        If Evaluate("COUNTIF(" & [Table].Columns(3).Address & ",""" & abrev(i) & """)") > 0 Then
            d(abrev(i)) = v(i)
            message = message & abrev(i) & " : " & v(i) & vbCrLf
        End If
    Next

    message = "Dictionnaire d'abréviations :" & vbCrLf & message
   
    MsgBox message

End Sub