Fusion de lignes si doublon de certaines colonnes

[pinou95]

Bonjour à tous,

J'ai bien cherché sur tout le forum et malgré une profusion de fils très intéressants je n'arrive pas à trouver mon bonheur. Je me lance donc en tant que nouveau, d'autant qu'à priori la solution est une macro et je n'y connais rien!

J'ai sur une feuille une liste de données correspondant à un portefeuille de brevets.
Ce tableau est issue d'un export d'un logiciel spécifique.
Chaque ligne correspond à un brevet.
Le problème c'est que dans ce tableau il existe de nombreux doublons avec une seule modification: le numéro de brevet.
En effet, chaque pays protégé pour une même invention aura une référence différente.
Ces doublons sont identifiables via leur numéro de priorité identique ou la référence.

Je souhaiterai fusionner ces doublons et "concaténer" la variable (numéro de brevet) dans une même cellule avec une séparation par point virgule afin d'utiliser ce tableau dans un outil de cartographie. Il ne devrait alors y avoir plus qu'une ligne correspondant à une invention.

Le fil le plus proche me semble être celui-ci.
Mais les variables sont dans des colonnes distinctes alors quelles sont dans la même dans mon cas. De plus le résultats doit nécessairement être comme dans l'exemple pour que je puisse l'analyser par la suite.
Evidemment mon tableau a un petit millier de lignes

Ci-dessous un fichier explicatif.

Merci d'avance aux généreux!

 

[Robert]

Re : Fusion de lignes si doublon de certaines colonnes

Bonjour Pinou, bonjour le forum,

Une solution par macro. J'ai commenté le code pour t'aider une peu...

Sub Macro1()
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim d As Object 'déclare la variable d (Dictionnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim tmp As Variant 'déclare la variable tmp (tableau TeMPoraire)
Dim i As Integer 'déclare la variable i (Incrément)
Dim nb As String 'déclare la variable nb (Numéro du Brevet)

Set o = Sheets("Classeur test intellixir") 'définit l'onglet o
dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'de'finit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = o.Range("A2:A" & dl) 'définit la plage pl
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d
For Each cel In pl 'boucle sur toutes les cellules éditées cel de la plage pl
    d(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
tmp = d.keys 'récupère dans le tableau temporaire tmp la liste des éléments uniques de la plage pl (sans doublon)
For i = LBound(tmp) To UBound(tmp) 'boucle 1 : sur tous les éléments uniques du tableau tmp
    o.Range("A1").AutoFilter Field:=1, Criteria1:=tmp(i) 'filtre les données dans la colonne 1 (=A) par rapport à l'élément unique tmp(i)
    If pl.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then 'condition : si le nombre de cellules visibles de la plage pl  est supérieur à 1 (= plusieurs numéros de brevet)
        For Each cel In pl.Offset(0, 3).SpecialCells(xlVisible) 'boucle 2 : sur toutes les cellules visibles de la plage pl décalée de 3 colonne à droite (=colonne D)
            nb = IIf(nb = "", cel.Value, nb & "; " & cel.Value) 'définit la variable nb (en ajoutant au fur et à mesure le numéro de brevet)
        Next cel 'prochaine cellule de la boucle 2
        pl.SpecialCells(xlCellTypeVisible).Cells(1, 4).Value = nb 'renvoie le numéro de brevet dans la première ligne, colonne 4 de la plage  des cellules visibles
        pl.SpecialCells(xlCellTypeVisible).Cells(2, 1).Resize(pl.SpecialCells(xlCellTypeVisible).Rows.Count - 1, 1).EntireRow.Delete 'supprime les autre lignes en dessous
    End If 'fin de l acondition
    o.Range("A1").AutoFilter 'supprime le filtre automatique
    nb = "" 'remet à zéro le numéro de brevet
Next i 'prochain cellule de la boucle 1
End Sub

 

[Paf]

Re : Fusion de lignes si doublon de certaines colonnes

Bonjour à tous

une version sans dictionnaire, sans doute moins rapide
Par sécurité, les données sont copiées en feuille 1 (qui doit exister) puis triées dans l'ordre des N° de priorité puis en partant de la dernière ligne, si la ligne précédentes = même N°de priorité: concaténation du n° brevet dans la ligne précédente:

Sub pinou95()
Dim WksA As Worksheet, WksB As Worksheet, DerLig As Long, TabloA, i As Long

Set WksA = Worksheets("Classeur test intellixir") ' Nom de la feuille ou se trouvent les données
Set WksB = Worksheets("Feuil1") ' Nom de la feuille ou les données seront copiées et traitées
   

DerLig = WksA.Range("A" & Rows.Count).End(xlUp).Row ' recherche du N° de la dernière ligne
TabloA = WksA.Range("A1:G" & DerLig)  'copie des données dans un tableau

Application.ScreenUpdating = False

WksB.Range("A1").Resize(UBound(TabloA, 1), 7) = TabloA 'copie du tableau dans la feuille de travail
With WksB
.Range("A1:G" & DerLig).Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess 'on trie les données dans l'ordre
                                                                                    'des N° de priorité
For i = DerLig To 2 Step -1 ' de la dernière à la 2ème ligne
    If .Cells(i, 3) = .Cells(i - 1, 3) Then 'si N° de priorité est ègal celui de la ligne précédente
        .Cells(i - 1, 4) = .Cells(i - 1, 4) & " ; " & .Cells(i, 4) 'copie le N° brevet dans la ligne du dessus
        .Rows(i).Delete Shift:=xlUp 'suppression de la ligne courante
    End If
Next

.Columns("A:G").AutoFit
End With

Application.ScreenUpdating = True
End Sub

Bonne suite

 

[pinou95]

Re : Fusion de lignes si doublon de certaines colonnes

Bonjour Robert.

Merci çà fonctionne parfaitement et super rapide!
Je comprends que tu as utilisé le dictionnaire ce qui explique la vitesse d’exécution.

Paf merci pour ta proposition, elle fonctionne aussi mais au jeu de la vitesse d’exécution du code sur mon fichier réel tu as perdu

Merci en tout cas à vous deux, les deux solutions fonctionnant parfaitement. Et bravo à vous pour la réactivité!

Je me met maintenant à essayer de comprendre les deux codes pour ressayer seul en cas d'évolution du besoin.
Les commentaires devraient m'aider

Peut-être à bientôt sur le forum.

 

[pinou95]

Re : Fusion de lignes si doublon de certaines colonnes

Bonjour Paf,

Après amélioration de mon fichier de départ je me replonge dans le problème.
Ta proposition fonctionnais sur mon fichier test mais étrangement impossible de la faire fonctionner sur mon fichier propre.
J'ai bien modifier la plage (j'ai plus de colonnes qu'au départ) mais si je les récupère bien dans la Feuil1, la macro bug au niveau de la ligne ".Range("A1:G" & DerLig).Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess 'on trie les données dans l'ordre"
Pour info j'ai 2 colonnes de plus. J'ai donc remplacé G par I et suis passer à 9 au lieu de 7 dans la ligne "WksB.Range("A1").Resize(UBound(TabloA, 1), 7) = TabloA 'copie du tableau dans la feuille de travail"

Si tu as une idée...

 

[Paf]

Re : Fusion de lignes si doublon de certaines colonnes

Re bonjour

suivant sur quelle feuille on se trouve pour lancer la macro, il peut effectivement y avoir une erreur.

modifier la ligne suivante:
.Range("A1:G" & DerLig).Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess

en
.Range("A1:G" & DerLig).Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlGuess

La colonne sur laquelle s'effectue le tri n'était bien référencée avec la feuille , en rajoutant le . devant Range("C2") tout rentre dans l'ordre . (en principe)

Bonne suite et bon courage

 

[pinou95]

Re : Fusion de lignes si doublon de certaines colonnes

Bonjour Paf,

Cela fonctionne parfaitement. C'est super merci encore !