grrrr les dico !

[gosselien]

Bonjour,

un problème simple, qui malgré mes lectures sur le site de JB, ne trouve pas de solution parce que ça ne veut pas rentrer dans ma tête ...Triste
Mais j'espère comprendre cette méthode au lieu de la copier bêtement dans certaines questions/réponses ici.

Le fichier attaché montre 2 tableau exemples avec à gauche ce que nous avons et à droite ce à quoi je voudrais arriver mais par la méthode des dictionnaires uniquement , pour la rapidité et pour comprendre, donc des commentaires seraient les bienvenus dans le code.
On garde toutes les cellules "factures" et "produit" et une seule fois le montant qui est en fait le total de la facture.

Merci

 

[BOISGONTIER]

Re : grrrr les dico !

Bonsoir,

Cette méthode , qui suppose les lignes de factures sont regroupées; doit être très rapide.
Le dictionnaire aurait un intérêt si les lignes de factures n'étaient pas regroupées (mais dans ce cas, j'ai des doutes sur cette présentation)

Sub essai()
  a = [A2:D29]
  i = 1
  Do While i <= UBound(a)
    tmp = a(i, 1): m = i
    tt = 0
    Do While a(i, 1) = tmp
      tt = tt + a(i, 3)
      i = i + 1: If i > UBound(a) Then Exit Do
    Loop
    a(m, 4) = tt
  Loop
  a = Application.Index(a, Evaluate("Row(1:" & UBound(a) & ")"), Array(1, 2, 4)) ' sup col3 de a()
  [m2].Resize(UBound(a), UBound(a, 2)) = a
End Sub

ou

Sub essai2()
  a = [A2:C29]
  i = 1
  Do While i <= UBound(a)
    tmp = a(i, 1): m = i
    tt = 0
    Do While a(i, 1) = tmp
      tt = tt + a(i, 3): a(i, 3) = ""
      i = i + 1: If i > UBound(a) Then Exit Do
    Loop
    a(m, 3) = tt
  Loop
  [m2].Resize(UBound(a), UBound(a, 2)) = a
End Sub

Un exemple où le dictionnaire augmente la vitesse:

indexation d'un tableau par un dictionnaire


JB

 

[job75]

Re : grrrr les dico !

Bonsoir gosselien, JB,

Puisque gosselien veut du Dictionary :

Sub Somme()
Dim t, t1, d As Object, i&, x
t = [A1].CurrentRegion: t1 = t
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t1)
  t1(i, 3) = Empty
  x = t(i, 1)
  If Not d.exists(x) Then d(x) = i
  t1(d(x), 3) = t1(d(x), 3) + t(i, 3)
Next
[H1].CurrentRegion.ClearContents
[H1].Resize(UBound(t), 3) = t1
End Sub

A+

 

[gosselien]

Re : grrrr les dico !

Bonsoir,

Cette méthode qui suppose le tableau trié doit être très rapide. Le dictionnaire aurait un intérêt si le tableau n'était pas trié.

Haa si c'est le maître lui-même qui répond

Il est présenté ici trié mais c'est pour l'exemple, dans la réalité il peut ne pas l'être ...

Merci

 

[gosselien]

Re : grrrr les dico !

Merci, je vais tenter de comprendre ça, même si ça parait enfantin à certains ..

P.

 

[gosselien]

Re : grrrr les dico !

Question à Job 75

Est-il est possible à la place du total de n'avoir qu'un exemplaire de chaque montant ici ?
Je cherche mais...
Donc en face de

Produit01-->1000
Produit02-->2000
Produit03-->3000
Désolé pour mon incompétence, je ne trouve pas seul ...

Merci

 

[job75]

Re : grrrr les dico !

Re,

Il faut être clair, vous voulez peut-être dire :

FACTURE 01-->1000
FACTURE 02-->2000
FACTURE 03-->3000

Alors peut-être :

Sub Facture()
Dim t, d As Object, i&
t = [A1].CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  If d.exists(t(i, 1)) Then t(i, 3) = ""
  d(t(i, 1)) = ""
Next
[H1].CurrentRegion.ClearContents
[H1].Resize(UBound(t), 3) = t
End Sub

A+

 

[gosselien]

Re : grrrr les dico !

Re,

Il faut être clair, vous voulez peut-être dire :

FACTURE 01-->1000
FACTURE 02-->2000
FACTURE 03-->3000

Alors peut-être :

Sub Facture()
Dim t, d As Object, i&
t = [A1].CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  If d.exists(t(i, 1)) Then t(i, 3) = ""
  d(t(i, 1)) = ""
Next
[H1].CurrentRegion.ClearContents
[H1].Resize(UBound(t), 3) = t
End Sub

A+

Oui

pas toujours facile d'exprimer le besoin, mais j'ai 2 versions à présent à étudier

Merci !!!

 

[BOISGONTIER]

Re : grrrr les dico !

Si c'est le total par facture

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

Si c'est le total au fur et à mesure des produits de chaque facture

Sub Cumul_AuFurEtAMesure_produits()
  a = [A2:C29]
  i = 1
  Do While i <= UBound(a)
    CodeFact = a(i, 1): m = i
    tt = 0
    Do While a(i, 1) = CodeFact
      tt = tt + a(i, 3): a(i, 3) = tt
      i = i + 1: If i > UBound(a) Then Exit Do
    Loop
  Loop
  [p2].Resize(UBound(a), UBound(a, 2)) = a
End Sub

JB

 

[gosselien]

Re : grrrr les dico !

Super , comme toujours

Merci !!!

 

[job75]

Re : grrrr les dico !

Re,

A ce que j'ai compris le problème du post #6 n'est qu'un cas d'école permettant d'étudier le Dictionary.

Bonne nuit.

 

[gosselien]

Re : grrrr les dico !

Tout est bon à voir, le même résultat de plusieurs manières pour apprendre comment ça fonctionne et je dois dire, que ce n'est pas aussi évident pour moi que pour vous 2...
Encore merci !

 

[job75]

Re : grrrr les dico !

Bonjour gosselien, JB, le forum,

En complément de mon post #3, une macro plus élaborée avec tri et bordures :

Sub Somme()
Dim t, d As Object, i&, x
t = [A1].CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  x = t(i, 1)
  If Not d.exists(x) Then d(x) = i Else _
    t(d(x), 3) = t(d(x), 3) + t(i, 3): t(i, 3) = ""
Next
Application.ScreenUpdating = False
[H1].CurrentRegion.Borders.LineStyle = xlNone
[H1].CurrentRegion.ClearContents
With [H1].Resize(UBound(t), 3)
  .Value = t
  .Sort [H1], Header:=xlYes 'tri
  .Borders.Weight = xlThin 'bordures
End With
End Sub

[Edit] Fichier joint.

Bonne journée.

 

[gosselien]

Re : grrrr les dico !

Merci

bonne journée

P.