Code VBA pour classement

Bonjour,

Je suis très novice en VBA et je cherche de l'aide, je m'explique, j'ai une base de donnée assez important du mouvement de sortie magasins par article et à chaque article, on y rattache une nature comptable et je voudrais classer les articles par ordre d'importance (décroissant) par nature comptable.

Je me trouve très difficile de le faire à l'aide des formule Excel et ce pour cela, je me suis adressé à votre forum.

Cordiallement

Après plusieurs essais, j'ai arrivé finalement à attacher mon fichier, il s'agit en fait d'une petite extraction de mes données.

Merci encore une fois

Salut mssm16,

Bonne année 2017!

si j'ai bien compris ta demande, voici ton fichier.

Pour ce qui est de la présentation graphique de ton classement, il y a évidemment mieux mais je ne connais pas le maniement des graphiques!

A+

Bonjour, et meilleurs voeux,

Je l'ai pas compris exactement pareil A voir :

Sub Classement()
    Dim Cpt(), CArt(), et, n&, i&, pl&, dl&, a&, k%, ca%, nCpt$
    Application.ScreenUpdating = False
    With ActiveSheet
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1:E" & n).Sort key1:=.Range("B1"), order1:=xlAscending, _
         key2:=.Range("E1"), order2:=xlDescending, Header:=xlYes
        et = Array("Article", "Désignation article", "MNT")
        pl = 2: nCpt = .Cells(pl, 2)
        For i = 2 To n
            If .Cells(i + 1, 2) <> nCpt Then
                dl = i: ReDim CArt(dl - pl + 2, 2)
                For a = 2 To UBound(CArt, 1)
                    For k = 1 To 5 Step 2
                        CArt(a, (k - 1) / 2) = .Cells(pl + a - 2, k)
                    Next k
                Next a
                For k = 0 To 2
                    CArt(1, k) = et(k)
                Next k
                CArt(0, 0) = nCpt
                ca = ca + 1: ReDim Preserve Cpt(1 To ca): Cpt(ca) = CArt
                pl = dl + 1: nCpt = .Cells(pl, 2): Erase CArt
            End If
        Next i
    End With
    With Worksheets.Add(after:=ActiveSheet)
        For a = 1 To UBound(Cpt)
            With .Cells(1, a * 3 - 2).Resize(UBound(Cpt(a), 1) + 1, 3)
                .Value = Cpt(a)
                .Columns(2).ColumnWidth = 32
                .Columns(3).NumberFormat = "0"
                .BorderAround xlContinuous, xlThin
                With .Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                With .Rows(1)
                    .MergeCells = True
                    .HorizontalAlignment = xlCenter
                    .BorderAround xlContinuous, xlThin
                End With
                With .Rows(2)
                    .HorizontalAlignment = xlCenter
                    .BorderAround xlContinuous, xlThin
                End With
            End With
        Next a
    End With
End Sub

NB- La proc. de classement, en elle-même est assez réduite... la moitié est occupée par la mise en forme sur une nouvelle feuille.

Cordialement.

Merci et mes meilleurs vœux de bonheur , de santé et de réussite pour 2017

IL reste de donner les numéros d'articles sans doublons et à part ça, tout est dans l'ordre.

Tu aurais pu en faire part au départ !

On fait une épuration préalable :

Sub Epurer()
    Dim d As Object, k, mnt#, n&, i&, T()
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    With ActiveSheet
        n = .Cells(.Rows.Count, 2).End(xlUp).Row
        For i = 2 To n
            k = .Cells(i, 2) & "|" & .Cells(i, 1) & "|" & .Cells(i, 3): mnt = .Cells(i, 5)
            If d.exists(k) Then
                mnt = CDbl(d(k)) + mnt: d(k) = mnt
            Else
                d(k) = mnt
            End If
        Next i
        ReDim T(d.Count, 3): i = 0
        For Each k In d.keys
            i = i + 1: T(i, 3) = CDbl(d(k)): k = Split(k, "|")
            T(i, 0) = k(0): T(i, 1) = k(1): T(i, 2) = k(2)
        Next k
        T(0, 0) = "Nature comptable": T(0, 1) = "Article"
        T(0, 2) = "Désignation article": T(0, 3) = "MNT"
        .Range("A1:E" & n).ClearContents
        .Range("A1").Resize(d.Count + 1, 4).Value = T
        Set d = Nothing
    End With
End Sub

Procédure qui sera lancée par la précédente avant de s'attaquer au classement...

Attention, l'épuration, ramenant la base à 4 colonnes et modifiant l'ordre des colonnes, cela induit pas mal de petites modifs dans la proc. précédente... !