Faire un classement ...

[LuluPa]

Bonjour a tous
Je viens à vous pour résoudre un petit (peut être gros) problème, j’espère que je vais être assez clair

Dans l’onglet « FACTURES FOURNISSEURS » j’ai mes lignes avec les différent fournisseurs, lorsque j’ai fait le règlement je mets un « X » via une petite moulinette « Made in ROBERT, LAPIX » merci ROBERT, LAPIX, et automatiquement la ligne est transfert dans l’onglet « Factures FOURNISSEURS CLASSEE » (en bas en dernière position)

Maintenant … j’ai besoin de faire un classement dans l’onglet « Factures FOURNISSEURS CLASSEE » par un simple clique, par « Fournisseurs », par « Dates », de faire la somme des factures, HT, TVA, TTC (dans chaque colonne) du mois et pour que ce soit plus sympathique a la lecture faire une séparation entre 2 fournisseurs

Voila … je vous remercie par avance

Lulu

 

[Dranreb]

Re : Faire un classement ...

Bonsoir.
vite fait avec les outils Excel:

Sub Classement()
Dim Plg As Range
Set Plg = Intersect(Feuil8.[A1:J65536], Feuil8.UsedRange)
Plg.RemoveSubtotal
Plg.Sort Key1:=Feuil8.[A2], Order1:=xlAscending, Key2:=Feuil8.[C2], Order2:=xlAscending, Key3:=Feuil8.[B2], Order3:=xlAscending, _
   Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
Plg.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 6, 7), Replace:=True, PageBreaks:=False, SummaryBelowData:=False
Plg.ClearOutline
Set Plg = Intersect(Feuil8.[E:E].SpecialCells(xlCellTypeFormulas, 1).EntireRow, Feuil8.[A:I])
With Plg.Borders(xlEdgeTop): .LineStyle = xlContinuous: .Weight = xlThick: .ColorIndex = xlAutomatic: End With
Plg.Font.Bold = True
Intersect(Feuil8.[A:A], Plg).ClearContents
End Sub

Cordialement.

 

[LuluPa]

Re : Faire un classement ...

Merci Dranreb pour ta reponse 🙂
Cela fonction bien, mais il est possible de faire le total de chaque mois par fournisseur


Merci

 

[Dranreb]

Re : Faire un classement ...

En gardant la simplicité de cette programmation ce devrait être possible à l'aide d'une colonne supplémentaire portant la formule en J3 par exemple:

=$A3&" - "&ANNEE($C3)*100+MOIS($C3)

et en demandant les sous totaux à chaque rupture sur ce critère colonne J plutôt que sur la A Fournisseur, Plg.Subtotal GroupBy:=10 au lieu de 1.
À+

 

[LuluPa]

Re : Faire un classement ...

je ne vois pas comment mettre en partique ...

 

[Dranreb]

Re : Faire un classement ...

J'en étais sûr...
Nouvelle procédure:

Sub Classement()
Dim Plg As Range
Set Plg = Intersect(Feuil8.[A1:J65536], Feuil8.UsedRange)
Plg.RemoveSubtotal
Plg.Sort Key1:=Feuil8.[A2], Order1:=xlAscending, Key2:=Feuil8.[C2], Order2:=xlAscending, Key3:=Feuil8.[B2], Order3:=xlAscending, _
   Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
Plg.Columns(10).FormulaR1C1 = "=RC1&""-""&YEAR(RC3)*12+MONTH(RC3)"
Plg.Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(5, 6, 7), Replace:=True, PageBreaks:=False, SummaryBelowData:=False
Plg.ClearOutline
Plg.Columns(10).ClearContents
Set Plg = Intersect(Feuil8.[E:E].SpecialCells(xlCellTypeFormulas, 1).EntireRow, Feuil8.[A:I])
With Plg.Borders(xlEdgeTop): .LineStyle = xlContinuous: .Weight = xlThick: .ColorIndex = xlAutomatic: End With
Plg.Font.Bold = True
End Sub

À+

 

[LuluPa]

Re : Faire un classement ...

merci Dranreb ... vraiment super 🙂 🙂 🙂