Macro somme des doublons en colonne

[mime1508]

Bonjour à tous,

Aprés plus d'une semaine de recherche sur les forums et notamment celui-ci qui est pour moi le plus clair, je me décide à demander de l'aide car je ne m'en sort pas.

J'ai un tableau ci-joint dans lequel la colonne C contient des n°. Certains sont des doublons.
Voici le résultat auquel je dois arriver :

- pour chaque doublon, je ne veut garder qu'une ligne sur laquelle les cumuls de toutes les colonnes suivantes (du moins celles contenant des chiffres : E, F, G I, J, K, L...) auront été calculés.

- De plus, ce serait bien que dans la colonne D (libellé), un libellé des doublons soir repris (peu importe lequel).

- pour les numéros n'ayant pas de doublons, je garde la ligne tel quel.

Voilà, je ne sais pas si c'est réalisable, le plus important pour moi étant de ne garder qu'une ligne avec les cumuls de chaque colonne.
Je vous remercie tous par avance de votre aide précieuse.

Mime

 

[Robert]

Re : Macro somme des doublons en colonne

Bonsoir Mime et bienveni dans le forum. bonsoir le forum,

Je te propose la macro ci-dessous :

Sub Macro1()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim x As Byte 'déclare la variable x
Dim y As Integer 'déclare la variable y
 
Set pl = Range("C4:C" & Range("D65536").End(xlUp).Row) 'définit la plage pl (D pour la fin à cause des formules en C)

For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    If cel.Interior.ColorIndex <> 3 Then 'condition 1 : si la ligne n'est pas rouge
        
        'condition 2 : si le nombre d'occurrence de la cellule cel dans la plage pl est supérieur à 1
        If Application.WorksheetFunction.CountIf(pl, cel.Value) > 1 Then
            pa = cel.Address 'définit la première adresse
            Set r = pl.Find(cel.Value, cel, xlValues, xlWhole) 'définit la recherche
            
            If Not r Is Nothing Then 'condition 3 : si il existe au moins une autre occurrence (on sait que oui "condition 2" )
                Do 'exécute
                    r.EntireRow.Interior.ColorIndex = 3 'remplit la ligne de rouge
                    
                    For x = 5 To 37 'boucle 2 : sur les colonnes 5 à 37
                        Select Case x 'action en fonction de la colonne
                            Case 5 To 7, 9 To 37 'colonne 5 à 7 et 9 à 37 (à adapter éventuellement)
                                'additionne à la valeur de départ, la valeur de la nouvelle occurrence
                                Cells(cel.Row, x).Value = Cells(cel.Row, x).Value + Cells(r.Row, x)
                        End Select 'fin de l'action en fonction de la colonne
                    Next x 'prochaine colonne de la boucle 2
                    
                    Set r = pl.FindNext(r) 'redéfinit la recherche r (occurrence suivante)
                Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
            End If 'fin de la condition 3
        
        End If 'fin de la condition 2
        
    End If 'fin de la condition 1
Next cel 'prochaine cellule de la boucle
 
'suppression des lignes doublon
For y = Range("D65536").End(xlUp).Row To 4 Step -1 'boucle inversée de la la dernière ligne éditée à la ligne 4
    If Rows(y).Interior.ColorIndex = 3 Then Rows(y).Delete 'si la ligne est rouge, supprime la ligne
Next y 'prochaine ligne de la boucle
 
End Sub

 

[mime1508]

Re : Macro somme des doublons en colonne

Robert, tu es mon sauveur !!!
Ca marche impeccable !

Merci aussi d'avoir intégré tes commentaires. J'ai pu décortiquer et ça m'aide beaucoup à comprendre comment tu as raisonné et comment ça fonctionne.

Merci encore de ton aide et de ta rapidité.
Bonne journée.