Elimination de doublons et aggrégation se sommes

[Phillip]

Bonjour,

Je suis encore sur mon étude de compte en banque, et je suis devant un problème de doublon. Alors j'ai trouvé toutes les façons de gérer et éliminer les doublons dans ce forum, et qui marchent très bien, mais ce que je voudrais c'est d'une part éliminer les doublons, et d'autre part totaliser les sommes correspondants dans la colonne suivante...

Je joins un petit exemple... L'idéal serait également que les colonnes où mes doublons sont élimines et mes sommes reportées se retrouvent en première colonne, mais bon, c'est la cerise sur le gâteau, car éliminer des colonnes, je sais faire !!

merci de votre aide

 

[bcharef]

Re : Elimination de doublons et aggrégation se sommes

Bonjour Phillip,
Bonjour à toutes et à tous.

Un essai avec un Tableau Croisé Dynamique.

A vous lire et bon courage

Cordialement.

BCharef

 

[JHA]

Re : Elimination de doublons et aggrégation se sommes

Bonjour Phillip, le forum,

un essai en pièce jointe
Feuille 1 divers exemples
Feuille 2 Exemple en application

Pas de suppression des doublons mais report en feuille 2.

JHA

 

[Phillip]

Re : Elimination de doublons et aggrégation se sommes

Certes certes...merci en tous cas de vos suggestions, mais j'aimerais préserver la philosophie de mon code, et avec les TCD, ça remet tout en cause :-(

J'aurais voulu intégrer ça dans le code genre suivant (l'un ou l'autre):

'Set mondico = CreateObject("Scripting.Dictionary")
    'For Each c In Range([A1], [A65000].End(xlUp))
     ' If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
    'Next
    '[C1].Resize(mondico.Count) = Application.Transpose(mondico.items)
'***********************
Dim Tablo, Liste, i
Set Liste = CreateObject("Scripting.Dictionary")
    For Each cel In Range([A1], [A65000].End(xlUp))
        If Not Liste.Exists(cel.Value) Then
        i = i + 1
        Liste.Add cel.Value, cel.Value
        End If
    Next
    Tablo = Liste.items
    For i = 0 To Liste.Count - 1
      Cells(i + 1, 3) = Tablo(i)
    Next

'******************************************************

'Z = 1
   ' For i = 1 To Range("A65536").End(xlUp).Row
    'present = False
        'For y = 1 To Range("B65536").End(xlUp).Row
         '   If Cells(i, 1) = Cells(y, 2) Then present = True
        'Next y
        'If present = False Then
           ' Cells(Z, 2) = Cells(i, 1)
            'Z = Z + 1
        'End If
    'Next i

Des idées ?

 

[Phillip]

Re : Elimination de doublons et aggrégation se sommes

Bon, voilà ce que j'ai fait...Je sais, vous pouvez crier, c'est pas beau, mais ça fait ce que je veux...

Je commence par un petit tri, sinon, je ne supprime pas les rubriques non connexes...Je sais, aïe, aïe, aïe...

Range(Cells(3, 1), Cells(rangdf, 2)).Select
    Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
Range(Cells(rangdf + 2, 1), Cells(rangdm, 2)).Select
    Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
Range(Cells(rangdm + 2, 1), Cells(rangcr, 2)).Select
    Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'Aggregation des rubriques, et suppression des lignes en double

   For i = 3 To Range("A65536").End(xlUp).Row
            If Cells(i, 1) = "" Then
            GoTo suitec:
            ElseIf Cells(i, 1) = Cells(i + 1, 1) Then
            Cells(i, 2) = Cells(i, 2) + Cells(i + 1, 2)
            Cells(i + 1, 1).EntireRow.Delete
      
            
            End If
suitec:
    Next i

Merci de votre aide de toutes façons !