Supprimer doublon avec total

Bonjour à tous,

J'ai un fichier dans lequel avec des codes produits(A), quantité (B) et prix (C).

Certains codes apparaissent plusieurs fois et je souhaiterai faire un total en colonne D et supprimer les doublons.

En pièce jointe une partie du fichier qui comporte un peu moins de 3000 lignes...

Merci d'avance, bonne journée.

Bonjour,

à tester

Sub Compile()
Dim Lg&, i&, x&
    Application.ScreenUpdating = False
    Lg = Range("a" & Rows.Count).End(xlUp).Row

    '--- tri colonne A ---
    Range("a2:d" & Lg).Sort _
        Key1:=Range("a2"), Order1:=xlAscending, _
    Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

    '--- compile si besoin ---
    For i = 2 To Lg
        If Cells(i + 1, "a") = Cells(i, "a") Then
            x = i
            Do While Cells(x + 1, "a") = Cells(i, "a")
               Cells(i, "b") = Cells(i, "b") + Cells(x + 1, "b")
               Cells(x + 1, "c").ClearContents
               x = x + 1
            Loop
            i = x
        End If
    Next i
        On Error Resume Next
    Range("c2:c" & Lg).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Amicalement

Claude

Merci infiniment Claude, c'est plus que parfait !

Outre le fait que cela solutionne mon problème, je viens de faire mes premiers pas dans MVB en collant les lignes de commande dans cet univers stratosphérique !

Il ne me reste plus qu'à essayer de trouver où l'on coche le fait que le sujet soit résolu...

Bonne journée.

Amicalement.

pour solder le poste, dans ton message

Bonjour,

• Méthode rapide
• Ne modifie pas l'ordre initial

Sub DoublonsTotal()
  Set d = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    d(c.Value) = d(c.Value) + c.Offset(, 1).Value
    d2(c.Value) = c.Offset(, 2)
  Next c
  [A2:C1000].ClearContents
  [a2].Resize(d.Count, 1) = Application.Transpose(d.keys)
  [b2].Resize(d.Count, 1) = Application.Transpose(d.items)
  [c2].Resize(d.Count, 1) = Application.Transpose(d2.items)
End Sub

Ceuzin

Bonjour Ceuzin,

merci également pour cette méthode qui ne change pas l'ordre initial et qui m'a déjà servi ce matin pour un autre fichier.

Ah si seulement le forum des utilisateurs Sage était aussi dynamique, réactif et efficace que celui-ci...

Bonne journée.