Problème doublons lignes selon plusieurs critères et fusion

Bonjour à tous et Joyeux Noël !!!

Je sollicite votre aide pour résoudre un problème... Dans le fichier que je vous ai joint, j'aimerais si possible:

• fusionner les doublons (c'est à dire dans mon cas, pour une ligne donnée, les données en colonnes A, B et C sont identiques à celle d'une autre ligne du tableau).
• ne pas supprimer les lignes des doublons ! La colonne D est différentes pour chaque doublon !
• sommer les quantités des doublons dans une nouvelle colonne

Je vous remercie par avance et vous souhaite à tous un excellent Noël,

Salut le forum

Le code suivant devrait faire le travail

Sub TriAndMerge()
 Dim Plage As Range
 Dim I As Integer, J As Integer

Set Plage = Range("A3").CurrentRegion.Offset(2)
Application.DisplayAlerts = False

    Plage.Sort _
    Key1:=Range("C3"), Order1:=xlAscending, _
    Key2:=Range("B3"), Order2:=xlAscending, _
    Key3:=Range("A3"), Order3:=xlAscending, _
    Header:=xlYes

I = 3
  Do While Cells(I, 1) <> ""
    J = I
      Do While Cells(I, 1) = Cells(J, 1) And Cells(I, 2) = Cells(J, 2) And Cells(I, 3) = Cells(J, 3)
        I = I + 1
      Loop
  Cells(J, 1).Resize(I - J).MergeCells = True
  Cells(J, 2).Resize(I - J).MergeCells = True
  Cells(J, 3).Resize(I - J).MergeCells = True
  Cells(J, 5) = Application.Sum(Cells(J, 5).Resize(I - J))
  Cells(J, 5).Resize(I - J).MergeCells = True
  Loop

Application.DisplayAlerts = True
Set Plage = Nothing

End Sub

Que la magie de Noël vous apporte joie et bonheur.

Mytå

Bonjour Mytå,

C'est exactement ce que voulais !! Je vous remercie mille fois et vous souhaite un excellent Noël !

Bonne journée,

Bonjour à tous,

J'avais commencé à regarder sans voir la réponse de Mytå,

je poste quand même, résultat en feuille "Résultat"

Sub Compile() 'départ bouton Feuil1
'--- macro Claude pour Walden le 25/12/2011 ---
Dim Lg&, i%, x%, J%
    Application.ScreenUpdating = False
    Lg = Range("A65536").End(xlUp).Row
    With Sheets("Résultat")
        .Cells.Clear
        Columns("a:e").Copy Destination:=.Range("a1")
        .Activate
    End With

    Columns("e").Copy Destination:=Columns("f")         'pour format
    Range("f1") = "Quantité (somme)"                    'en-tête
    Range("f2:f" & Lg) = "=a2&b2&c2"                    'concatène A:C

    '--- tri colonnes F et date ---
    Range("a2:f" & Lg).Sort _
        Key1:=Range("f2"), Order1:=xlAscending, _
        Key2:=Range("d2"), Order2:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:= _
    False, Orientation:=xlTopToBottom
    '---
    For i = 2 To Lg
        If Cells(i + 1, "f") = Cells(i, "f") Then
            x = i
            Do While Cells(x + 1, "f") = Cells(i, "f")
                Cells(x + 1, "a").ClearContents
                x = x + 1
            Loop
            Cells(i, "f") = "=sum(e" & i & ":e" & x & ")"
            '--- fusionne les cellules ---
            Application.DisplayAlerts = False
            Range(Cells(i, "f"), Cells(x, "f")).MergeCells = True
            For J = 1 To 3                              'colonnes A:C
                Range(Cells(i, J), Cells(x, J)).MergeCells = True
            Next J
            Application.DisplayAlerts = True
            i = x
        Else
            Cells(i, "f") = Cells(i, "e")
        End If
    Next i
End Sub

Bonne fin d'année

Claude

Bonjour à tous,

Je reviens vers vous avec un nouveau problème...

J'essaie d'adapter le code de Mytå au tableau en pj, mais sans succès... j'obtiens une erreur "argument introuvable" ligne 13...J'en profite pour vous exposer ce que je souhaite faire dans le fichier joint.... Est-ce possible ou pas ?

Merci par avance de votre aide,

Bonne journée !

Re le forum

Sous Excels 2003, il n'est pas permis de trier plus de 3 colonnes à la fois

    Plage.Sort _
    Key1:=Range("h2"), Order1:=xlAscending, _
    Key2:=Range("g2"), Order2:=xlAscending, _
    Key3:=Range("f2"), Order3:=xlAscending, _
    Key4:=Range("e2"), Order4:=xlAscending, _
    Key5:=Range("d2"), Order5:=xlAscending, _
    Key6:=Range("c2"), Order6:=xlAscending, _
    Key7:=Range("b2"), Order7:=xlAscending, _
    Key8:=Range("a2"), Order8:=xlAscending, _
    Header:=xlYes

Mytå

Il faut sépare la plage de tri en groupe de 3

With Plage
  .Sort _
    Key1:=Range("H2"), Order1:=xlAscending, _
    Key2:=Range("G2"), Order2:=xlAscending, _
    Key3:=Range("F2"), Order3:=xlAscending, _
    Header:=xlYes
  .Sort _
    Key1:=Range("E2"), Order1:=xlAscending, _
    Key2:=Range("D2"), Order2:=xlAscending, _
    Key3:=Range("C2"), Order3:=xlAscending, _
    Header:=xlYes
  .Sort _
    Key1:=Range("B2"), Order1:=xlAscending, _
    Key2:=Range("A2"), Order2:=xlAscending, _
    Header:=xlYes
End With

Référence Microsoft a écrit :

Lorsque vous triez une liste, Microsoft Excel permet d'utiliser un maximum de trois colonnes ou champs. Si vous souhaitez trier une liste de plus de trois champs, vous devez la trier plusieurs fois, en prenant un maximum de trois champs à chaque fois. Vous devez également effectuer ce tri en sélectionnant les champs dans l'ordre inverse de leur importance.

Mytå

Merci Mytå, la fusion fonctionne parfaitement !

J'aimerais calculer la moyenne des lignes identiques à partir de la colonne 9, j'ai essayé d'adapter le code suivant (seule la colonneç est considérée dans mes essais):

Sub TriAndMerge()
 Dim Plage As Range
 Dim I As Integer, J As Integer

Set Plage = Range("A2").CurrentRegion.Offset(1)
Application.DisplayAlerts = False

With Plage
  .Sort _
    Key1:=Range("H2"), Order1:=xlAscending, _
    Key2:=Range("G2"), Order2:=xlAscending, _
    Key3:=Range("F2"), Order3:=xlAscending, _
    Header:=xlYes
  .Sort _
    Key1:=Range("E2"), Order1:=xlAscending, _
    Key2:=Range("D2"), Order2:=xlAscending, _
    Key3:=Range("C2"), Order3:=xlAscending, _
    Header:=xlYes
  .Sort _
    Key1:=Range("B2"), Order1:=xlAscending, _
    Key2:=Range("A2"), Order2:=xlAscending, _
    Header:=xlYes
End With
    I = 2
  Do While Cells(I, 1) <> ""
    J = I
      Do While Cells(I, 1) = Cells(J, 1)
        I = I + 1
      Loop
  Cells(J, 1).Resize(I - J).MergeCells = True
  Cells(J, 2).Resize(I - J).MergeCells = True
  Cells(J, 3).Resize(I - J).MergeCells = True
  Cells(J, 4).Resize(I - J).MergeCells = True
  Cells(J, 6).Resize(I - J).MergeCells = True
  Cells(J, 7).Resize(I - J).MergeCells = True
  Cells(J, 8).Resize(I - J).MergeCells = True
  Cells(J, 9) = Application.Average(Cells(J, 9).Resize(I - J))
  Cells(J, 9).Resize(I - J).MergeCells = True
  Loop

Application.DisplayAlerts = True
Set Plage = Nothing

End Sub
 

Je pense que la fonction average n'est pas adaptée... Est-ce bien le cas ?

Bonjour à tous,

Je ne sais pas si ce poste est soldé,

Trop de tris, nuit au tri !

1) il faudrait déjà s'assurer du bon tri, peut-être concaténer certaines colonnes.

(dans ton tri préconisé, tu perd la ligne 4, sans doublons)

2) pour calculer les moyennes, il faut convertir les données en numérique.

fichier à tester

Amicalement

Claude

Bonjour Claude,

C'est parfait ! J'avais eu à peu près le même résultat mais de façon bine plus complexe...

Je vais utiliser ton fichier pour résoudre ma demande https://forum.excel-pratique.com/excel/besoin-d-aide-pour-la-creation-d-un-fichier-type-complexe-t27814.html...

Merci encore !

Bonne journée