Scripting Dictionnary : modifier code pour nb occurence SVP

  • Initiateur de la discussion Initiateur de la discussion zebanx
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

zebanx

XLDnaute Accro
Bonjour à tous,

En reprenant le (super) code de Laetitia90 (😉) - et étant bien rouillé sur le sujet - , pourriez-vous l'amender SVP pour incorporer le nombre d'occurences ?

Faut-il créer un deuxième dictionnaire SVP ? Ou peut-on se débrouiller avec une instruction de type dico.items SVP ?

Je vous remercie par avance pour votre aide.

zebanx

Code:
Sub somme()
' code transmis par laetitia90
Dim t(), i As Long, m As Object, c As Byte, z
Set m = CreateObject("Scripting.Dictionary")

t = Range("a2:c" & Cells(Rows.Count, 1).End(3).Row).Value2
For i = 1 To UBound(t)
    z = t(i, 1)
    If m.Exists(z) Then
        For c = 2 To 3:  t(m(z), c) = t(m(z), c) + t(i, c): Next c
        Else
        x = x + 1
        For c = 1 To 3: t(x, c) = t(i, c): Next c:   m(z) = x
    End If
  Next i
[F2].Resize(x, 3) = t
[I2].Resize(x, 1) = Application.Transpose(m.items)

End Sub
 

Pièces jointes

Bonjour.
Avec ma fonction Gigogne ça s'écrirait comme ça :
VB:
Sub Résumé()
Dim Nom As SsGr, L As Long, TRés(1 To 1000, 1 To 4)
For Each Nom In Gigogne(Feuil1.[A2:C2], 1)
   L = L + 1
   TRés(L, 1) = Nom.Id
   TRés(L, 2) = Nom.Somme(2)
   TRés(L, 3) = Nom.Somme(3)
   TRés(L, 4) = Nom.Count
   Next Nom
[F4].Resize(10000, 4) = TRés
End Sub
 
Bonjour Dranreb.

Merci pour la célérité et la transmission de ce code.
Peux-tu m'indiquer stp à partir de quelle version on peut utiliser Gigogne ?
Utilisant une vieille version d'excel, je ne sais pas si cela poserait certaines difficultés.

Je te remercie pour test précisions et bonne soirée -)
 
Bonsoir zebanx, Bernard,

Il suffit d'ajouter une 4ème colonne au tableau de Laetitia et de la traiter :
Code:
Sub somme()
' code transmis par laetitia90
Dim t(), i As Long, m As Object, c As Byte, z
Set m = CreateObject("Scripting.Dictionary")

t = Range("a2:d" & Cells(Rows.Count, 1).End(3).Row).Value2
For i = 1 To UBound(t)
    z = t(i, 1)
    If m.Exists(z) Then
        For c = 2 To 3:  t(m(z), c) = t(m(z), c) + t(i, c): Next c
        t(m(z), 4) = t(m(z), 4) + 1
    Else
        x = x + 1
        For c = 1 To 3: t(x, c) = t(i, c): Next c:   m(z) = x
        t(x, 4) = 1
    End If
  Next i
[F2].Resize(x, 4) = t

End Sub
A+
 
Re-bonsoir,

Le code a bien fonctionné en tout cas sur le fichier enregistré en xls, bravo !!
Sur le fichier initial, quelques soucis de bug d'exécution du code "résumé après enregistrement / rappel en référence de gigldx sous 2003.
Je regarderai demain et de manière plus attentive généralement sur tes posts avec l'utilisation de "gigogne".

Merci pour tout, bonne nuit
zebanx
 
Job75, tu utilise bien la méthode Range parfois, non ? Et bien ça, oui, c'est une usine à gaz ! Entre autres. Et les TCD, tu ne crois pas que c'en est une aussi ? Ma fonction Gigogne est tout à fait raisonnable à coté de cette programmation monstrueuse, mais qui ne se voit seulement pas !
 
Dernière édition:
Re Bernard,

Si tu as fait partie de l'équipe qui a créé VBA chez Microsoft alors tu sais ce que tu dis 🙂

Mais c'est vrai qu'une usine à gaz est de toute façon utile si des milliers/millions de gens l'utilisent.

C'est le cas de "Gigogne" ???

A+
 
Bonjour Job75, Dranreb, le forum

@job75.
Toutes mes "confuses", j'ai effectivement complètement zappé le post 4 hier soir😳
Je devais être bien gigogné hier soir pour passer ça !!😀
Solution parfaite comme d'habitude donc un grand merci et très content d'avoir pu échanger avec toi -).


@Dranreb
Encore merci et je serai plus attentif aux réponses apportées utilisant Gigogne. Mais il me faut progressivement faire une sorte de main-courante pour reprendre les meilleures pratiques. C'est toutefois fort agréable de voir une telle proposition, au demeurant gratuite, pour aider les xl-nautes dans leurs démarches.
Comme pour le site de Jacques Boisgontier, votre bienveillance (nous) sur un support structuré aide🙂 (n'oublions pas non plus les incontournables du code - comme Job75 - dont il faut enregistrer les codes et se faire ses propres tuto pour progresser).

Bonne journée à tous les deux et merci pour votre célérité.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
476
Réponses
3
Affichages
671
Retour