cibleo
XLDnaute Impliqué
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 €
Pouvez-vous m'aider ?
Merci Cibleo
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 €
VB:
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 SubPouvez-vous m'aider ?
Merci Cibleo
Dernière édition: