scripting.dictionary

pasquetp · 29 Janvier 2015

Bonjour,

je débute la partie dictionary vb script car je dois faire des analyses de données assez importante

j'ai donc commencé les cours ici:

https://vbaforexcel.wordpress.com/

j'ai compris le raisonnement de cette macro que vous trouverez ici

https://vbaforexcel.files.wordpress.com/2013/09/dictionnaire2.xls

Sub test()
'Dans la fenêtre VBA, sélectionner Outils, Références et cocher Microsoft Scripting Runtime
Dim Dico As Object
Dim c As Byte
Dim ii As Variant, jj As Variant
Set Dico = CreateObject("scripting.dictionary")

c = 2
Do Until IsEmpty(Cells(c, 1))
If Not Dico.exists(Cells(c, 1).Value) Then
Dico(Cells(c, 1).Value) = 0.9 * Cells(c, 3)
Else
Dico(Cells(c, 1).Value) = Dico(Cells(c, 1).Value) + Cells(c, 3)
End If
c = c + 1
Loop

Range("E1").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
Range("F1").Resize(Dico.Count, 1) = Application.Transpose(Dico.items)

Set Dico = Nothing

End Sub

***************************************

j'ai voulu remplacer le do until par un for next

Sub plplp()
'Dans la fenêtre VBA, sélectionner Outils, Références et cocher Microsoft Scripting Runtime
Dim Dico As Object
Dim c As Object

Set Dico = CreateObject("scripting.dictionary")

For Each c In Range("A2", Range("A2").End(xlDown))

If Not Dico.exists(Cells(c, 1).Value) Then
Dico(Cells(c, 1).Value) = 0.9 * Cells(c, 3)
Else
Dico(Cells(c, 1).Value) = Dico(Cells(c, 1).Value) + Cells(c, 3)
End If

Next

Range("E1").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
Range("F1").Resize(Dico.Count, 1) = Application.Transpose(Dico.items)

Set Dico = Nothing

End Sub

***************

je comprends absoulement pas pourquoi je me paye une erreur "incompatibilité de type"

quelqu'un aurait une idée?

Merci bcp

Pierre

Paf · 29 Janvier 2015

Re : scripting.dictionary

Bonjour

Dans le premier code, Cells(c,1) représente la cellule en ligne c (initialisé à 2 puis incrémenté) et colonne 1. Cells(2,1) c'est la cellule A2 ...

Dans le deuxième code c est la cellule de la plage Range("A2", R....
c sera successivement la cellule A2, puis A3, puis A4...

Cells(c, 1) serait la cellule de coordonnées ligne A2 et colonne1 (au mieux) ça ne marche donc pas

Il faudrait écrire

Dico(c.Value) = 0.9 * c.Offset(0, 2).Value

A+

pasquetp · 29 Janvier 2015

Re : scripting.dictionary

Merci à vous de cette information qui m'a bien échappé

je viens de le corriger mais l'erreur persiste:

Sub plplp()
'Dans la fenêtre VBA, sélectionner Outils, Références et cocher Microsoft Scripting Runtime
Dim Dico As Object
Dim c As Range

Set Dico = CreateObject("scripting.dictionary")

For Each c In Range("A2", Range("A2").End(xlDown))

If Not Dico.exists(c.Value) Then
Dico(c.Value) = 0.9 * c.Offset(0, 2)
Else
Dico(c.Value) = Dico(c.Value) + c
End If

Next

Range("E1").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
Range("F1").Resize(Dico.Count, 1) = Application.Transpose(Dico.items)

Set Dico = Nothing

End Sub

Paf · 29 Janvier 2015

Re : scripting.dictionary

Re,

Sans préciser la ligne en cause !

a priori c'est .value qui manque sur 0.9 * c.Offset(0, 2) ou Dico(c.Value) + c
à moins que c.Offset(0, 2) ne contienne pas de valeur numérique
à moins que je me sois trompé dans le Offset
....

Si un erreur persiste précisez ce que vous voulez faire avec un classeur d'essais

A+

pasquetp · 29 Janvier 2015

Re : scripting.dictionary

re

je vous remets le fichier

ce n'est qu'un exercice que j'essaie de faire

j'ai pu avancer un peu

Sub plplp()
'Dans la fenêtre VBA, sélectionner Outils, Références et cocher Microsoft Scripting Runtime
Dim Dico As Object
Dim c As Range
Set Dico = Nothing
Set Dico = CreateObject("scripting.dictionary")

For Each c In Range("A2", Range("A2").End(xlDown))

If Not Dico.Exists(c) Then
Dico(c) = 1 * c.Offset(0, 2).Value
Else
Dico(c) = Dico(c) + c.Offset(0, 2).Value
End If

Next

Range("E2").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
Range("F2").Resize(Dico.Count, 1) = Application.Transpose(Dico.items)

Set Dico = Nothing

End Sub

je n'arrive malheuresement pas a avoir le Dico.Count

j'obtiens:

Client 1 100
Client 15 100
Client 11 110
Client 19 120
Client 5 130
Client 23 140
Client 12 150
Client 11 160
Client 17 170
Client 5 180
Client 11 190
Client 12 200
Client 23 210
Client 1 220
Client 15 230
Client 16 240
Client 17 250
Client 12 260
Client 19 270
Client 20 280
Client 21 290
Client 11 300
Client 23 310
Client 5 320
Client 1 330

alors que je pensai obtenir:

Client 1 640
Client 15 320
Client 11 749
Client 19 378
Client 5 617
Client 23 646
Client 12 595
Client 17 403
Client 16 216
Client 20 252
Client 21 261

Merci de votre aide

Paf · 29 Janvier 2015

Re : scripting.dictionary

Re

je n'arrive malheuresement pas a avoir le Dico.Count

Vous n'arrivez pas à déterminer le nombre d'éléments dans le Dico ? (auquel cas msgbox Dico.Count)

Le résultat est curieux puisque dans un Dico les clés sont uniques !

Je regarde votre classeur

A+

Paf · 29 Janvier 2015

Re : scripting.dictionary

Re

Plusieurs macro dans votre classeur

La macro test() dans le module1 obtient bien les résultats attendus ! même si vous n'utilisez plus la boucle For Each...

je regarde les suivantes

pasquetp · 29 Janvier 2015

Re : scripting.dictionary

re

en effet la macro test donne des resultats qui me paressent logiques

Range("E1").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
Range("F1").Resize(Dico.Count, 1) = Application.Transpose(Dico.items)

Ce lien n'existe plus

d'après ce site: Dico.COUNT : nombre de paires clé/item dans le dictionnaire.

ainsi ca me parait logique qu'il donne le résultat suivant

Client 1 640
Client 15 320
Client 11 749
Client 19 378
Client 5 617
Client 23 646
Client 12 595
Client 17 403
Client 16 216
Client 20 252
Client 21 261

mais la maro avec le for next (Sub plplp) nous donne la liste de départ et pourtant il inclut

Range("E1").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
Range("F1").Resize(Dico.Count, 1) = Application.Transpose(Dico.items)

c'est juste dingue.

merci de vos recherches

Paf · 29 Janvier 2015

Re : scripting.dictionary

Re

Dans la sub plplp() ça ne fonctionnait pas car on a Dico(c) au lieu de Dico(c.Value) , le 1 * c.Offset(0, 2).Value ne servait à rien

Code:

If Not Dico.Exists(c.Value) Then
Dico(c.Value) = c.Offset(0, 2).Value
Else
Dico(c.Value) = Dico(c.Value) + c.Offset(0, 2).Value
End If

A+

pasquetp · 29 Janvier 2015

Re : scripting.dictionary

d'accord !!!!

merci de vos conclusions

ce sujet est vraiement passionant

merci encore

je vais poursuivre mes travaux pratiques et je reviens vers vous si j'ai d'autres questions

merci encore

BOISGONTIER · 29 Janvier 2015

Re : scripting.dictionary

Bonsoir,

Code:

Sub SousTotal()
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
     mondico(c.Value) = mondico(c.Value) + c.Offset(, 2).Value
  Next c
  [E2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
  [f2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
End Sub

Objet dictionary

JB

Paf · 30 Janvier 2015

Re : scripting.dictionary

Bonjour à tous

Dans la mesure où la première "clé" trouvée doit voir son item réduit de 90%, a priori pas d'autre solution ( ? ) que:

Code:

If Not Dico.exists(c.Value) Then
   Dico(c.Value) = 0.9 * c.Offset(0, 2).Value
Else
   Dico(c.Value) = Dico(c.Value) +c.Offset(0, 2).Value
End If

A+

gosselien · 30 Janvier 2015

Re : scripting.dictionary

Bonjour à tous,

comment explique-t-on la différence entre le total par client avant et après tri de la colonne des clients ?
en lançant Sub Test dans module1 et pas le code qui est dans la feuille 1 (Sub plplp())

Paf · 30 Janvier 2015

Re : scripting.dictionary

Bonjour gosselien

la valeur du premier élément d'un même client est multipliée par 0,9.

Suivant l'ordre des valeurs la somme sera différente

A+

gosselien · 30 Janvier 2015

Re : scripting.dictionary

Bonjour et merci Paf....

je n'ai pas suffisamment lu et oui , tout simplement c'est dans le code, il ne multiplie que le premier d'un même client 🙁

P.

scripting.dictionary

pasquetp

XLDnaute Occasionnel

Paf

XLDnaute Barbatruc

pasquetp

XLDnaute Occasionnel

Paf

XLDnaute Barbatruc

pasquetp

XLDnaute Occasionnel

Pièces jointes

Paf

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

pasquetp

XLDnaute Occasionnel

Paf

XLDnaute Barbatruc

pasquetp

XLDnaute Occasionnel

BOISGONTIER

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

gosselien

XLDnaute Barbatruc

Pièces jointes

Paf

XLDnaute Barbatruc

gosselien

XLDnaute Barbatruc

Discussions similaires

scripting.dictionary

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency