Scripting.Dictionary : fusion de plusieurs feuilles

[cibleo]

Bonsoir le forum

Pour bien comprendre, cliquez sur le bouton Feuil2 :
Maintenant, j'aimerais réaliser le même type de synthèse mais en affichant le résultat pour chacune des différentes stations services. (ici 3)
Ainsi pour chaque période, 3 lignes devraient apparaitre avec tout son détail en regard de la colonne A.

Exemple : Février 2012
BP --> 2 pleins --> 80,90 € --> 56,32 L --> 1,436 €
ESSO --> 14 pleins --> 551,20 € --> 381,93 L --> 1,443 €
SHELL --> 15 pleins --> 758,45 € --> 526,85 L --> 1,440 €

Avec la macro présentée, je n'obtiens qu'une seule ligne pour février 2012 :

31 pleins --> 1390,55 € ---> 965,10 L --> 1,441 €

Sub FusionConso()
  Set mondico = CreateObject("Scripting.Dictionary")
  Set mondico1 = CreateObject("Scripting.Dictionary")
  Set mondico2 = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  Range("A1:F" & Range("F65536").End(xlUp).Row).Clear 'Efface toute la Feuil2
  For s = 1 To 3 'On copie les données des 3 premières feuilles ds Feuil2 : colonnes A,B,C et D
     Range(Sheets(s).[A3], Sheets(s).[D65536].End(xlUp)).Copy [A65536].End(xlUp).Offset(1, 0)
  Next s
  'On trie ces données par ordre chronologique
  Range("A2:D" & Range("D65536").End(xlUp).Row).Sort Key1:=[A2], Order1:=xlAscending, Key2:=[D2], Order2:=xlAscending, Header:=xlGuess
  For Each C In Range("A2:A" & Range("A65536").End(xlUp).Row)
    mondico(Format(C.Value, "mmmm yyyy")) = mondico(Format(C.Value, "mmmm yyyy")) + 1
    mondico1(Format(C.Value, "mmmm yyyy")) = mondico1(Format(C.Value, "mmmm yyyy")) + CDec(C.Offset(, 1).Value)
    mondico2(Format(C.Value, "mmmm yyyy")) = mondico2(Format(C.Value, "mmmm yyyy")) + C.Offset(, 2).Value
  Next C
  Range("A2:D" & Range("D65536").End(xlUp).Row).Clear 'Efface la Feuil2 à nouveau
  Range("A1") = "Périodes": Range("B1") = "Stations": Range("C1") = "Nbre de pleins"
  Range("D1") = "Montants TTC": Range("E1") = "Volumes": Range("F1") = "Prix du litre Gazole"
  Range("A2").Resize(mondico.Count, 1) = Application.Transpose(mondico.keys) 'Clé Périodes
  Range("C2").Resize(mondico.Count, 1) = Application.Transpose(mondico.items) 'Nbre de pleins
  Range("D2").Resize(mondico.Count, 1) = Application.Transpose(mondico1.items) 'Cumul Montants
  Range("E2").Resize(mondico.Count, 1) = Application.Transpose(mondico2.items) 'Cumul Volumes
  For Lig = 2 To Range("A" & Rows.Count).End(xlUp).Row
  'Prix du litre en colonne F
    Cells(Lig, 6).Value = Cells(Lig, 4).Value / Cells(Lig, 5).Value
  Next
  Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "# ##0.00 $"
  Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).NumberFormat = "# ##0.00 L"
  Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row).NumberFormat = "# ##0.000 $"
Application.ScreenUpdating = True
End Sub

Pouvez-vous m'aider ?

Merci Cibleo

 

[mutzik]

Re : Scripting.Dictionary : fusion de plusieurs feuilles

bonjour,

si tu rajoutes une colonne en mettant le num du véhicule, tu peux mettre toutes tes données dans une seule feuille
dans cette feuille, tu fais un tableau croisé dynamique qui feras ce que tu demandes sans aucune macro !
(et c'est la meilleure façon de travailler ...)