Microsoft 365 Dictionnaire suite et fin avec un code sobre et élégant

[Goufra]

Bonjour

Pour mettre fin à une discussion autour de dictionnary » je vous adresse le fichier qui reprend tout ce qui a été écrit.

Le code est sobre et très élégant.
Vous pouvez donc remercier notre ami "ma pomme"

Sans oublier patricktoulon et les questions de Fronck xlDnaute junior​

Je crois ne rien avoir omis.

Je compte sur "mapomme" pour réagir au cas où !



Navré d’avoir été si long à revenir vers vous.
Je ne suis pas « le maître du temps »

Bien cordialement
Goufra

 

[job75]

Bonjour Goufra,

Pour mettre fin à une discussion autour de dictionnary

Bah pour mettre fin à une discussion on n'en crée pas une nouvelle !!!

En plus vous nous obligez à rechercher cette fameuse discussion !!!

A+

 

[Goufra]

Vous avez certainement raison
La discussion contient tellement de panneaux que cela en devient illisible.

Ouvrez la pièce jointe, vous avez le traitement pratiquement complet d'un dictionnaire.
Vous aurez à votre disposition un code simple, sobre et élégant, grâce aux apports successifs de la discussion..

Navré de vous avoir déplu.
Je n'aurais pas du faire référence à l'ancienne discussion.
Dont acte

<<<<<<<<quant à d'éventuels lecteurs n'hésitez pas à ouvrir le fichier joint
et à faire part de vos remarques éventuelles

Me voilà avec une casserole !
Bonne journée
Goufra JC

 

[job75]

Je n'aurais pas du faire référence à l'ancienne discussion.

Vous n'auriez pas dû quitter l'ancienne discussion.

 

[Goufra]

Vous pouvez dire si le contenu vous Convient !

 

[job75]

Vous pouvez dire si le contenu vous Convient !

Je n'ai même pas compris à quoi sert votre fichier !

 

[Valtrase]

Salut le fil,
Petites réflexions...
Module B_autre_possibilité

Option Explicit
' // Pourquoi mettre tout cela en tête de module alors qu'il n'y a qu'une
' // procédure dans ce module ?
Dim D As New Scripting.Dictionary
Dim T1() As Variant
Dim i As Longg
Sub test0()

    ' // Pourquoi faire cela
    D.RemoveAll
    T1 = Range("tableau1")
    ' // Et puis cela
    D.CompareMode = TextCompare
    ' Pour finir avec cela ?
    Set D = Nothing

    For i = 1 To UBound(T1)
        If Not D.Exists(T1(i, 2)) Then D.Add T1(i, 2), T1(i, 3)
    Next i

    ' // il serait bien de savoir de quel plage on parle et sur quelle feuille non ?
    Range(Range("G7"), Range("G7").End(xlDown)).Resize(, 2).Clear
    Range("G7").Resize(D.Count, 1) = Application.Transpose(D.Keys)
    'Range("H7").Resize(D.Count, 1) = Application.Transpose(D.Items)

End Sub

Les remarques sur le module A_fabriq_dico sont les mêmes que celles du module B_autre_possibilité

 ' // Là on ne le vide pas on le réduit au néant
 Set dico = Nothing 'on vide le dictionnaire obtenu précédemment
' // Puisque tableau structuré il y a, pourquoi ne pas l'utiliser ?
    Range("tableau1").Select
    Range("B7:D6").AutoFilter

' // Super on va faire un sapin de noël
                [H7].Select
                ActiveCell.Offset(-3, 0).Clear
' // Là non seulement la feuille n'est pas renseignée, mais en plus on va donner du travail supplémentaire à Excel pour évaluer G7
                [G7].Select
                ActiveCell.Offset(-3, 0) = "Tg"
                ActiveCell.Offset(-4, 0) = "Nbre"

Bon j'en passe...
Il reste encore du travail du moins à mon goût.

 

[bsalv]

bonjour le fil,
ceci est une autre possibilité

Sub Test1()
     Dim Dict, T1, i

     Set Dict = CreateObject("scripting.dictionary")
     Dict.CompareMode = vbTextCompare

     T1 = Range("Tableau1").Value2           'lire le tableau
     For i = 1 To UBound(T1)
          Dict(T1(i, 2)) = Dict(T1(i, 2)) + T1(i, 3)     'cumuler l'item
     Next

     With Range("G7")
          .Resize(100, 2).ClearContents      'on efface les anciens résultats
          If Dict.Count Then
               With .Resize(Dict.Count)
                    .Value = Application.Transpose(Dict.Keys)     'clé
                    .Offset(, 1).Value = Application.Transpose(Dict.Items)     'item
                    .Resize(, 2).Sort .Range("B2"), xlDescending, Header:=xlNo     'trier
               End With
          End If
     End With
End Sub

EDIT : @job75, erreur corrigée

 

[job75]

Bonjour le forum,

@bsalv au lieu de Dict.CompareMode = TextCompare écrire Dict.CompareMode = vbTextCompare

A+

 

[Goufra]

Je n'ai même pas compris à quoi sert votre fichier !

à rien si ce n'est apprendre à se servir d'un dictionnaire .