Gestion de données multiples (suppression et addition)

Bonjour,

Je tente de supprimer des doublons, ou plutôt des données multiples dans un colonne en prenant en compte une valeur associée à chaque ligne euh, c'est compréhensible ça ?

Bon, voici le fichier : https://www.cjoint.com/c/CHEn7BSLrRd

et son aperçu :

Sur les plages A2 à B16, les données à considérer.

Je souhaite faire un bilan en ne mentionnant qu'une seule fois chaque donnée mais en additionnant le nombre associé.

En cliquant sur "BILAN", le résultat attendu est celui en jaune (E19 -> F22).

Or, le code suivant ne donne pas satisfaction :

Sub Rectangleàcoinsarrondis1_Cliquer()

' suppression doublons et calcul

Dim k As Long

Application.ScreenUpdating = False

Range("A2:B16" & NbLg).Sort Key1:=Range("A2"), Order1:=xlAscending, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal, DataOption2:=xlSortNormal

For k = 16 To 2 Step -1

If (Range("A" & k) = Range("A" & k - 1)) Then

Range("E" & k - 1) = Range("B" & k - 1) + Range("B" & k)

Rows(k).Delete

End If

Next k

End Sub

J'ai l'impression qu'il ne prends en compte que le doublons (2 fois la même donnée).

Pouvez-vous m'aider à modifier le code pour qu'il réponde à mes attentes ?

Merci!

Bonjour,

Me trompé je

Avec TCD

Cdlt

Bonjour

Bonjour Jean-Eric

Remplaces ta macro par celle-ci

Sub Rectangleàcoinsarrondis1_Cliquer()
' suppression doublons et calcul
Dim k As Long, Nblg As Long
Dim Mondico As Object

  Application.ScreenUpdating = False
  If Range("E2") <> "" Then
    Range("E2:F" & Range("E1").End(xlDown).Row).ClearContents
  End If
  Nblg = Range("A1").End(xlDown).Row
  Set Mondico = CreateObject("Scripting.dictionary")
  For k = 2 To Nblg
    Mondico(Range("A" & k).Value) = Mondico(Range("A" & k).Value) + Range("B" & k)
  Next k
  Range("E2").Resize(Mondico.Count) = Application.Transpose(Mondico.keys)
  Range("F2").Resize(Mondico.Count) = Application.Transpose(Mondico.items)
End Sub

Super, cette macro fonctionne à merveille !

Ce forum est d'une véritable aide... merci !