Fusionner des lignes en doublon et additionner leurs valeurs

miliev83 · 29 Mars 2016

Bonjour,

Je n'arrive pas à adapter le code du fichier joint (1er onglet) à mon tableau (2eme onglet) :
Je précise que mon tableau à un nombre de lignes variable

Code:

 Sub SupprLigne()
Dim i As Long
    For i = ActiveSheet.Range("A65536").End(xlUp).Row To 6 Step -1
        If Cells(i, 1).Value = Cells(i - 1, 1).Value And _
            Cells(i, 2).Value = Cells(i - 1, 2).Value And _
            Cells(i, 3).Value = Cells(i - 1, 3).Value And _
            Cells(i, 4).Value = Cells(i - 1, 4).Value And _
            Cells(i, 5).Value = Cells(i - 1, 5).Value And _
            Cells(i, 10).Value = Cells(i - 1, 10).Value Then
            Cells(i - 1, 6).Value = Cells(i - 1, 6).Value + Cells(i, 6).Value
            Cells(i - 1, 7).Value = Cells(i - 1, 7).Value + Cells(i, 7).Value
            Cells(i - 1, 8).Value = Cells(i - 1, 8).Value + Cells(i, 8).Value
            Cells(i - 1, 14).Value = Cells(i - 1, 14).Value + Cells(i, 14).Value
            Cells(i, 1).EntireRow.Delete
        End If
    Next i
End Sub

J'aimerai que lorsque sur 2 lignes différentes le contenu des colonnes A D E est identique sur chaque lignes, alors ces cellules fusionnent, alors que le contenu des cellues F G H I J K L M N et AB fusionnent en s'additionnant.
La fusion doit se faire sur la même feuille car j'ai plusieurs code qui s'enchaîne.

J'ai essayé ce code mais je ne suis pas sûre du

Code:

To 2 Step -1

car je ne sais pas à quoi cela correspond au juste ? 😕 🙄

Code:

Sub SupprLigne()
Dim i As Long
    For i = ActiveSheet.Range("A65536").End(xlUp).Row To 2 Step -1
        If Cells(i, 1).Value = Cells(i - 1, 1).Value And _
            Cells(i, 4).Value = Cells(i - 1, 4).Value And _
            Cells(i, 5).Value = Cells(i - 1, 5).Value Then
            Cells(i - 1, 6).Value = Cells(i - 1, 6).Value + Cells(i, 6).Value
            Cells(i - 1, 7).Value = Cells(i - 1, 7).Value + Cells(i, 7).Value
            Cells(i - 1, 8).Value = Cells(i - 1, 8).Value + Cells(i, 8).Value
            Cells(i - 1, 9).Value = Cells(i - 1, 9).Value + Cells(i, 9).Value
            Cells(i - 1, 10).Value = Cells(i - 1, 10).Value + Cells(i, 10).Value
            Cells(i - 1, 11).Value = Cells(i - 1, 11).Value + Cells(i, 11).Value
            Cells(i - 1, 12).Value = Cells(i - 1, 12).Value + Cells(i, 12).Value
            Cells(i - 1, 13).Value = Cells(i - 1, 13).Value + Cells(i, 13).Value
             Cells(i - 1, 28).Value = Cells(i - 1, 28).Value + Cells(i, 28).Value
            Cells(i, 1).EntireRow.Delete
        End If
    Next i
End Sub

J'ai l'impression que cela fonctionne 1 fois sur 2 😡

Merci par avance

laetitia90 · 29 Mars 2016

Re : Fusionner des lignes en doublon et additionner leurs valeurs

bonsoir miliev83 🙂
comme je comprends pour la feuille MON TABLEAU
une approche

Code:

Sub es()
  Dim t(), i As Long, m As Object, c As Byte, z
   Application.ScreenUpdating = 0
   Set m = CreateObject("Scripting.Dictionary")
   t = Range("a2:ab" & Cells(Rows.Count, 1).End(3).Row)
   For i = 1 To UBound(t)
   z = t(i, 1) & t(i, 4) & t(i, 5)
   If m.Exists(z) Then
    For c = 6 To 13:  t(m(z), c) = t(m(z), c) + t(i, c): Next c
    t(m(z), 28) = t(m(z), 28) + t(i, 28)
    Else
    x = x + 1
    For c = 1 To 28: t(x, c) = t(i, c): Next c:   m(z) = x
    End If
    Next i
    Range("a2:ab" & Cells(Rows.Count, 1).End(3).Row).ClearContents
    [a2].Resize(x, 28) = t
End Sub

cathodique · 30 Mars 2016

Re : Fusionner des lignes en doublon et additionner leurs valeurs

Bonjour Laetitia90,

Curieux, j'ai essayé ton code sur le fichier et il fonctionne. Enfin, c'est mon avis car je ne suis pas l'initiateur de ce post.
Ton code me plait beaucoup. Alors une petite question, comment le modifier pour calculer une moyenne.

@miliev83: excuse mon intrusion

Merci. Bonne journée.

miliev83 · 30 Mars 2016

Re : Fusionner des lignes en doublon et additionner leurs valeurs

Merci Laetitia, cela fonctionne bien 🙂 peux-tu me donner plus d'explication sur ce code ? au cas où mes colonnes viendraient à changer
🙂

Fusionner des lignes en doublon et additionner leurs valeurs

miliev83

XLDnaute Occasionnel

laetitia90

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

miliev83

XLDnaute Occasionnel

Discussions similaires

Fusionner des lignes en doublon et additionner leurs valeurs

miliev83

XLDnaute Occasionnel

laetitia90

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

miliev83

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency