Fusion de ligne si doublon par macro

[citizenbaban]

Bonjour à tous,

J'ai un petit problème avec une macro. Voici l'idée :
Je voudrais fusionner des lignes de B à H, si et seulement si, des dates en colonne A sont identiques sur plusieurs lignes.
Par exemple :

12/03/13 50 60 "vide" 10
12/03/13 50 60 "vide" 10
12/03/13 "vide" "vide" 100 "vide"

Donnerait :
12/03/13 50 60 100 10


En me balladant ici et ailleurs, j'ai trouvé un code qui fonctionne bien pour ce que la personne recherchait, mais pour être honnête, je ne le comprend pas ^^ Du coup ça serait surtout pour avoir quelques explications sur ce code, à quel chiffre correspond les colonnes, les lignes, etc. Car même en tatonnant, je n'obtiens que des résultats bizarres ^^

Voici le code :

Sub Groupage()
Dim Col As Integer, Lg As Long, nLg As Byte, Nom As String
Application.ScreenUpdating = False
Nom = Cells(2, 2): Lg = 2
While Nom <> ""
  While Cells(Lg, 2).Offset(nLg, 0) = Nom
    nLg = nLg + 1
    For Col = 3 To 7
      If Cells(Lg, Col) = "" Then
        Cells(Lg, Col) = Cells(Lg, Col).Offset(nLg, 0)
      End If
    Next
  Wend
  Lg = Lg + nLg
  Nom = Cells(Lg, 2)
  nLg = 0
Wend
For Lg = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
  If Application.WorksheetFunction.CountIf(Feuil1.Range("B:B"), Cells(Lg, 2).Value) > 1 Then
    Rows(Lg).EntireRow.Delete
  End If
Next
Application.ScreenUpdating = True
End Sub

Je ne sais plus ou je l'ai récupéré, donc si quelqu'un reconnait son code, désolé pour l'absence de référence

Merci beaucoup.
Citizen

 

[job75]

Re : Fusion de ligne si doublon par macro

Bonjour citizenbaban,

Le plus simple est de joindre un fichier significatif en donnant le résultat à obtenir.

A+

 

[citizenbaban]

Re : Fusion de ligne si doublon par macro

Bonjour Job,

J'ai un peu "peur" que si je mette un exemple, je me retrouve avec une macro qui fonctionnera mais dont je ne connaitrais pas le fonctionnement
Je préfère comprendre, quitte à passer du temps derrière pour le faire moi-même, c'est plus durable ^^

Ci-joint un exemple de ce que je souhaiterais, sachant que les données sont variables aussi bien en terme de lignes que de colonne.

Merci

Citizen

 

[_Thierry]

Re : Fusion de ligne si doublon par macro

Bonjour Citizen, Job75, le Forum

J'ai travaillé SANS ton dernier exemple et j'espère donc ne pas être à coté de la plaque....

Ci joint un exercice sur lequel je me suis efforcé d'indiquer pas mal de commentaires pour t'aider à comprendre.
Par contre mis à part un "Tag" sur la feuille Source, j'écris les nouveaux résultats sur une feuille Resulat...

PS Je n'utisie pas vraiment lecode que tu as proposé, mais il y a Mille et Un chemins en VBA pour arriver à ses fins !

Bonne Découverte
@+Thierry

 

[_Thierry]

Re : Fusion de ligne si doublon par macro

Re Citizen, Job, le Forum

Je viens de voir ton exemple, il est clair qu'en ne travaillant qu'avec ton premier Post:

Donnerait :
12/03/13 50 60 100 10

J'ai interprété bêtement que tu voulais une CONCATENATION du 50 60 100 10 arf ...

Mais maintenant les choses se corsent si il faut "ranger" les résulats en face de chaque rubrique :

63514

63515

63517

En voyant ceci, pour éviter de tomber dans un autre "piège" prévisible, si il y a plusieur fois pour la même date la même rubrique renseignée par un nombre, faut'il en faire l'addition ?

Personnellemnt je n'aurai pas plus de temps à consacrer à ce problème, mais j'espere que mon fichier t'aidera, et ma question aidera les contributeurs/trices à faire avancer le schmilblick !

Cordialement
@+Thierry

 

[tototiti2008]

Re : Fusion de ligne si doublon par macro

Bonjour Citizen, Bonjour Job, Bonjour Thierry,

un essai sur base du fichier
Je suis parti du principe que :
-les dates son triées
-une même colonne n'est pas remplie plusieurs fois pour une même date
-seules les valeurs comptent, pas les formules

à tester

Sub FusionDoublons()
Dim i As Long
    With ThisWorkbook.Worksheets("Données")
        'Parcours des lignes de la fin au début
        For i = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1
            'Si la date de la ligne est égale à celle de la ligne précédente
            If .Range("A" & i).Value = .Range("A" & i - 1).Value Then
                'On copie les données de la ligne
                .Range("B" & i & ":H" & i).Copy
                'On colle dans la ligne précédente (collage spécial valeurs, blancs non compris)
                .Range("B" & i - 1).PasteSpecial Paste:=xlPasteValues, skipblanks:=True
                'On supprime la ligne
                .Range("B" & i).EntireRow.Delete
            End If
        Next i
    End With
    Application.CutCopyMode = False
End Sub

 

[_Thierry]

Re : Fusion de ligne si doublon par macro

Salut à Toi TotoTiTi !

Bien le skipblanks:=True, jamais utilisé mais il semble très bien pour ce cas là !

A condition comme tu le dis qu'il n'y ait pas d'addition à faire pour une même colonne à une même date...

Bien à vous, à toi
@+Thierry

 

[tototiti2008]

Re : Fusion de ligne si doublon par macro

Re,

Merci Thierry, dans la mesure où les cellules sont vraiment vides, aussi, mais bon ça avait l'air d'être correct sur le fichier fourni
En plus dans ce fichier il y a des formules qui pointent sur d'autre fichiers qu'on a pas, alors j'ai collé en valeur mais je ne sais pas si c'est le résultat attendu
ça fait plaisir de voir que tu as un peu de temps à passer sur le forum, toujours un plaisir de te croiser

 

[_Thierry]

Re : Fusion de ligne si doublon par macro

Re TotoTiti, Citizen, le Forum

Merci de ton petit mot oui un peu de temps en vacance et il pleut !

En attendant Citizen, si il a besoin d'addition, c'est fait ici dans une autre démo pour Maxime qui, lui, avait donné un fichier exemple qui ne porte pas à ambiguité

https://www.excel-downloads.com/threads/probleme-do-while-loop.203704/
Fil => Problème Do While Loop

Bien à vous

@+Thierry

 

[job75]

Re : Fusion de ligne si doublon par macro

Bonjour Marc, Thierry,

Une solution avec l'objet "Dictionary" et à la fin une conversion de données :

Sub Regrouper()
Dim plage As Range, ncol%, d As Object, i&, ii&, t1$, j%, t2$, k&
Set plage = Sheets("Données").Range("A1", Sheets("Données").UsedRange)
If plage.Rows.Count = 1 Then Exit Sub 'sécurité
ncol = plage.Columns.Count
plage.Sort plage(1), xlAscending, Header:=xlYes 'tri avec titres
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To plage.Rows.Count
  If plage(i, 1) <> "" Then
    If Not d.exists(plage(i, 1).Value2) Then
      ii = i + Application.CountIf(plage.Columns(1), plage(i, 1)) - 1
      t1 = ""
      For j = 2 To ncol
        t2 = ""
        For k = i To ii
          If plage(k, j) <> "" Then t2 = plage(k, j): Exit For
        Next
        t1 = t1 & Chr(1) & t2
      Next
      d(plage(i, 1).Value2) = plage(i, 1).Value2 & t1
    End If
  End If
Next
'---restitution---
With Sheets("Résultats")
  .Cells.ClearContents
  .[A1].Resize(d.Count) = Application.Transpose(d.items)
  Application.DisplayAlerts = False
  .[A:A].TextToColumns .[A1], xlDelimited, Other:=True, OtherChar:=Chr(1)
  .Activate
End With
End Sub

Son intérêt, sur un grand tableau, est d'être rapide.

Mais je doute que citizenbaban aime ça

Fichier joint.

Edit : j'ai ajouté un Exit For dans la boucle k, ce sera encore plus rapide.

A+

 

[_Thierry]

Re : Fusion de ligne si doublon par macro

Bonsoir Job74, le Fil


Interressant ce CreateObject("Scripting.Dictionary"), je l'ai déja vu passer sur un code de Pierre Jean, si je ne m'abuse. Il faudra que je me mette à essayer de l'utiliser.

Donc oui, testé et approuvé si Citizen n'a pas d'addition. Bravo
Et comme tu reconnais par contre Citizen risque d'avoir du mal à tout comprendre.

Bonne soirée
@+Thierry

 

[job75]

Re : Fusion de ligne si doublon par macro

Re,

Ah je constate que dans la feuille Résultats on obtient des dates sous forme de textes.

Il faut donc utiliser la propriété Value2 pour les cellules de la colonne A.

Je modifie mon post précédent.

Edit : noter aussi que Application.Transpose n'accepte pas plus de 65536 items.

Si la restitution donnait plus de 65536 lignes il faudrait faire une transposition par boucle.

A+

 

[tototiti2008]

Re : Fusion de ligne si doublon par macro

Re,

@Thierry :

tu reconnais par contre Citizen risque d'avoir du mal à tout comprendre

Oui, mais c'est très très rapide, donc en fonction de la masse d'information à tester, ça peut avoir son importance
Les dictionnaires sont même plus rapides que les collections pour supprimer les doublons
Si ça t'intéresse, tu peux aller voir par là : Objet dictionary

 

[_Thierry]

Re : Fusion de ligne si doublon par macro

Re TotoTiti

Merci à toi pour ce lien que je mets sous le coude.

Bonne Soirée
@+Thierry

 

[citizenbaban]

Re : Fusion de ligne si doublon par macro

Bonsoir à tous,

Merci de vous être penché sur mon problème aussi rapidement, et désolé pour l'absence, petite réunion de dernière minute, pas eu le temps de revenir au bureau.
Je potasse tout ça demain, et je reviens vers vous pour clore (je l'espère) le topic.
Et pour répondre rapidement aux questions, il n'est pas impossible que des lignes identiques en tout point existent (en théorie ça ne devrait pas arriver mais tout le monde n'est pas à l'aise avec un pc, encore moins avec excel, mieux vaut envisager le pire des cas), donc exit les additions de cellules.Les dates seront bien triées de la plus ancienne à la plus récente.
Par contre pour les valeurs des titres de colonnes (63512, etc), pas la peine de se prendre la tête avec ça, je pourrai l'insérer après si besoin ^^

Enfin dans tous les cas, je regarde ça à tête reposée, l'oeil vif, dès demain.
Encore merci.
Bonne nuit à tous.

Citizen