FUSIONNER / CONCATENER des DOUBLONS

Ctrl-Alt-Suppr · 16 Avril 2007

Bonsoir à tous,

Votre forum est vraiment très complet, mais après 1h de recherche, je me suis inscrits car je n'ai pas trouvé mon "bonheur".
En fait, ce que j'aimerai faire ne me parait pas très compliqué, mais pourtant je colle ...

Imaginez que je cherche à comparer des voitures ... (ex. complétement fictif)

colonneA ___ colonneB

PORSCHE ___ cuir
PORSCHE ___ 12 airbags
PORSCHE ___ 400 ch
SKODA _____ tissu
SKODA _____ 1 moitié d'airbag
SKODA _____ 1 cheval
SKODA _____ 1 attache-remorque

Ce que j'aimerai, c'est remettre sur une même ligne (si possible en rajoutant des caractères de séparation) les valeurs des "doublons" de la colonne A.

En clair :

PORSCHE ___ cuir / 12 airbags / 400 ch
SKODA _____ tissu / 1 moitié d'airbag / 1 cheval / 1 attache-remorque

J'ai bien essayé avec des SI(xxxx) et des & ... mais mon problème c'est que le nombre de "caractérisitiques pour chaque voiture" est différent, donc ma formule n'est pas recopiable.
Oui, car en tout, j'ai au moins 15.000 lignes ...

A savoir, je ne suis pas du tout programmeur (VBA, macros ...)
Toute aide, même partielle est la bienvenue car c'est assez important ...
Si cela doit se faire en plusieurs étapes (genre sur 3 colonnes supplémentaires) ce n'est pas génant.

En espérant que certains prendront le peine de m'aider ...
D'avance, merci !

Cordialement.

erilen · 5 Juillet 2017

bonjour tout le monde,
je besoins d'aide pour faire le suivant fichier avec les doublons...s'il vous plait aide moi.

erilen · 5 Juillet 2017

erilen à dit:
bonjour tout le monde,
je besoins d'aide pour faire le suivant fichier avec les doublons...s'il vous plait aide moi.

J'ai, mais je doublais la dernière valeur de chaque ligne

Sub Concatener()
Dim DerLig As Long, A As Long, G As Long 'Dimensionnement des variables de boucle
Dim MaConcat As String 'Dimensionnement de la variable texte
DerLig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row 'récupère le n° de la dernière ligne remplie
MaConcat = Sheets("feuil1").Cells(A + 2, 2).Value 'Récupère la première Pression
For A = 2 To DerLig 'Boucle qui passe sur toutes les lignes de 2 à la dernière
If Cells(A, 1) = Cells(A + 1, 1) Then 'Si la valeur de la colonne 1 de la cellule vérifiée est = à la suivante
MaConcat = MaConcat & "," & Cells(A + 1, 2) 'Alors adaptation du texte avec la valeur de la colonne B de la ligne suivante
Else 'Sinon
Cells(G + 2, 5) = Cells(A, 1) 'On place dans la colonne E le Code
Cells(G + 2, 6) = MaConcat 'On place dans la colonne F la Pression
MaConcat = Cells(A, 2) 'On recommence le texte au suivant
G = G + 1 'On incrémente la ligne de destination du résultat
End If
Next A
End Sub

gosselien · 5 Juillet 2017

Bonjour,

ce n'est pas un fichier XL ça mais un pdf, on ne sait pas faire grand chose avec...

Un fichier anonymisé serait bienvenu 🙂

P.

erilen · 5 Juillet 2017

gosselien à dit:
Bonjour,

ce n'est pas un fichier XL ça mais un pdf, on ne sait pas faire grand chose avec...

Un fichier anonymisé serait bienvenu 🙂

P.

merci beaucoup,

erilen · 5 Juillet 2017

gosselien à dit:
Bonjour,

ce n'est pas un fichier XL ça mais un pdf, on ne sait pas faire grand chose avec...

Un fichier anonymisé serait bienvenu 🙂

P.

ici mon VB..il 'y avez des erreurs mais je suis nulle...
Sub Concatener()
Dim DerLig As Long, i As Long, j As Long 'Dimensionnement des variables de boucle
Dim MaConcat As String 'Dimensionnement de la variable texte
DerLig = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row 'récupère le n° de la dernière ligne remplie
MaConcat = Sheets("feuil1").Cells(i + 2, 2).Value 'Récupère la première Pression
For i = 2 To DerLig 'Boucle qui passe sur toutes les lignes de 2 à la dernière
If Cells(i, 1) = Cells(i + 1, 1) Then 'Si la valeur de la colonne 1 de la cellule vérifiée est = à la suivante
MaConcat = MaConcat & "_" & Cells(i + 1, 2) 'Alors adaptation du texte avec la valeur de la colonne B de la ligne suivante
Else 'Sinon
Cells(j + 2, 5) = Cells(i, 1) 'On place dans la colonne E le Code
Cells(j + 2, 6) = MaConcat 'On place dans la colonne F la Pression
MaConcat = Cells(i, 2) 'On recommence le texte au suivant
j = j + 1 'On incrémente la ligne de destination du résultat
End If
Next i
End Sub

erilen · 5 Juillet 2017

BISSON Nicole à dit:

Bonjour,

Code:

Sub RegroupeSansDoublons()
   Set mondico = CreateObject("Scripting.Dictionary")
   For Each c In Range("a2", [a65000].End(xlUp))
     If Not mondico.exists(c.Value) Then
        mondico(c.Value) = c.Offset(, 1).Value
     Else
        mondico(c.Value) = mondico(c.Value) & "," & c.Offset(, 1).Value
     End If
  Next c
  [D2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
  [E2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
End Sub

BISSON

MERCI MERCI!!!!!! sa marche très bien

gosselien · 6 Juillet 2017

re,

sur base du fichier que tu as déposé 🙂

P.

Edit: pas vule message précédant de Nicole 🙁

VB:

Option Explicit

Sub EnColonne()
Dim d1, d2, d3, c
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
For Each c In Range("a1", [a65000].End(xlUp))
   If Not d1.Exists(c.Value) Then
      d1(c.Value) = c.Offset(0, 1) ' ajout dans dictionnaire
   Else
      d1(c.Value) = d1(c.Value) & "," & c.Offset(0, 1) ' 1 colonne après la première
   End If
   If Not d2.Exists(c.Value) Then
      d2(c.Value) = c.Offset(0, 2)
   Else
      d2(c.Value) = d2(c.Value) & "," & c.Offset(0, 2) ' 2e colonne après la première
   End If
   If Not d3.Exists(c.Value) Then
      d3(c.Value) = c.Offset(0, 3)
   Else
      d3(c.Value) = d3(c.Value) & "," & c.Offset(0, 3) '3e colonne après la première
   End If
Next c
If d1.Count = 0 Then Exit Sub
[f2].Resize(d1.Count) = Application.Transpose(d1.keys)
[g2].Resize(d1.Count) = Application.Transpose(d1.items)
[h2].Resize(d2.Count) = Application.Transpose(d2.items)
[i2].Resize(d3.Count) = Application.Transpose(d3.items)
End Sub

erilen · 6 Juillet 2017

gosselien à dit:

re,

sur base du fichier que tu as déposé 🙂

P.

Edit: pas vue le message précédant de Nicole 🙁

VB:

Option Explicit

Sub EnColonne()
Dim d1, d2, d3, c
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
For Each c In Range("a1", [a65000].End(xlUp))
   If Not d1.Exists(c.Value) Then
      d1(c.Value) = c.Offset(0, 1) ' ajout dans dictionnaire
   Else
      d1(c.Value) = d1(c.Value) & "," & c.Offset(0, 1) ' 1 colonne après la première
   End If
   If Not d2.Exists(c.Value) Then
      d2(c.Value) = c.Offset(0, 2)
   Else
      d2(c.Value) = d2(c.Value) & "," & c.Offset(0, 2) ' 2e colonne après la première
   End If
   If Not d3.Exists(c.Value) Then
      d3(c.Value) = c.Offset(0, 3)
   Else
      d3(c.Value) = d3(c.Value) & "," & c.Offset(0, 3) '3e colonne après la première
   End If
Next c
If d1.Count = 0 Then Exit Sub
[f2].Resize(d1.Count) = Application.Transpose(d1.keys)
[g2].Resize(d1.Count) = Application.Transpose(d1.items)
[h2].Resize(d2.Count) = Application.Transpose(d2.items)
[i2].Resize(d3.Count) = Application.Transpose(d3.items)
End Sub

merci, mais ca ne marche pas 🙁

gosselien · 6 Juillet 2017

erilen à dit:
merci, mais ca ne marche pas 🙁

Ha bon...

ici avec ton fichier j'ai le résultat correct mais je dis bien avec le fichier que tu as envoyé ; si le bon fichier n'a pas la même structure ou est situé ailleurs que en A1 ...

erilen · 6 Juillet 2017

gosselien à dit:
ici avec ton fichier j'ai le résultat correct mais je dis bien avec le fichier que tu as envoyé ; si le bon fichier n'a pas la même structure ou est situé ailleurs que en A1

no no, lui est le même, je ne sais pas pourquoi il me dit erreur de affichage et si je fais quelques modification a près il dit erreur 13...

Shou · 27 Juillet 2017

Hello !!

J'ai besoin d'aide sur un fichier .

J'ai essayer d'adapter la macro donnée plus haut mais sans succès.... 🙁

Je chercher à ce que tous les doublons des références sois supprimer et avoir en face les lignes correspondantes concatener

Je m'explique:

Dans l'onglet Extract du fichier excel ce trouve une extraction d'un logiciel.
Une même référence peut se trouver sur plusieurs lignes.
J'ai donc des références en doublons parfois jusqu'à 30 fois la même référence n'étant pas pour le même module et pouvant être sur plusieurs lignes (A,B,C,F...).

J'aimerais dans un nouvel onglet pouvoir retrouver une seule fois cette référence avec les lignes concatener dans la colonne à côté ( cf onglet Nouveau dans le fichier excel)
J'oublais, les références ne sont pas triées par ordre croissant on peu trouver une référence dans la première ligne excel puis ensuite dans la 68000ème ligne.

Je ne sais pas si c'est clair. J'essaye depuis deux jours. J'ai vraiment besoin de votre aide.

Merci d'avance

gosselien · 27 Juillet 2017

Bonjour @Shou ,

il est préférable de faire un nouveau post et de ne pas s'insérer dans un existant 🙂

P.

zebanx · 27 Juillet 2017

Bonsoir à tous

Un exemple avec un minimum de VBA (appelle à la fonction CONCAT) et quelques formules qui permettent de ne pas être contraint sur le nombre de lignes et de colonnes dans le code, me semble-t-il.

cdlt
thierry

@gosselien : jamais sans VBA (mais c'est si facile pour vous et quelques uns ici!) 😀

Shou · 28 Juillet 2017

gosselien à dit:
Bonjour @Shou ,

il est préférable de faire un nouveau post et de ne pas s'insérer dans un existant 🙂

P.

Ah au temps pour moi, je pensais que justement comme le sujet était plus ou moins le même il ne fallait pas re- créer de post et s'insérer dans celui-ci.

DariusBacchus · 15 Août 2019

JYLL à dit:

Re : FUSIONNER / CONCATENER des DOUBLONS

Bonsoir CTRL-ALT-SUP, ninbihan et le forum,

En effet une solution par macro avec ce code et classeur joint.

Code:

Sub Concatener()
Dim Ligne As Long, I As Long, J As Byte, Mémoire As String, Mot As String
For I = 1 To Range("A65536").End(xlUp).Row + 1
    If Left(Cells(I, 1), 8) <> Mémoire Then
    Mémoire = Left(Cells(I, 1), 8)
    If Ligne > 0 Then Cells(Ligne, 2) = Mot
        Ligne = Ligne + 1
        Mot = ""
        Mot = Cells(I, 1)
    Else
        J = Len(Cells(I, 1))
        While Mid$(Cells(I, 1), J, 1) <> "_"
            J = J - 1
        Wend
        Mot = Mot & " / " & Mid$(Cells(I, 1), J + 1, Len(Cells(I, 1)) - J + 1)
    End If
Next I
End Sub

Bon test.

JYLL à dit:

Re : FUSIONNER / CONCATENER des DOUBLONS

Bonsoir CTRL-ALT-SUP, ninbihan et le forum,

En effet une solution par macro avec ce code et classeur joint.

Code:

Sub Concatener()
Dim Ligne As Long, I As Long, J As Byte, Mémoire As String, Mot As String
For I = 1 To Range("A65536").End(xlUp).Row + 1
    If Left(Cells(I, 1), 8) <> Mémoire Then
    Mémoire = Left(Cells(I, 1), 8)
    If Ligne > 0 Then Cells(Ligne, 2) = Mot
        Ligne = Ligne + 1
        Mot = ""
        Mot = Cells(I, 1)
    Else
        J = Len(Cells(I, 1))
        While Mid$(Cells(I, 1), J, 1) <> "_"
            J = J - 1
        Wend
        Mot = Mot & " / " & Mid$(Cells(I, 1), J + 1, Len(Cells(I, 1)) - J + 1)
    End If
Next I
End Sub

Bon test.

bonsoir Jean Yves,
merci pour ton post, ton code est propre et il fonctionne !

FUSIONNER / CONCATENER des DOUBLONS

Ctrl-Alt-Suppr

Guest

erilen

Guest

Pièces jointes

erilen

Guest

gosselien

XLDnaute Barbatruc

erilen

Guest

Pièces jointes

erilen

Guest

erilen

Guest

gosselien

XLDnaute Barbatruc

erilen

Guest

gosselien

XLDnaute Barbatruc

erilen

Guest

Shou

Guest

Pièces jointes

gosselien

XLDnaute Barbatruc

zebanx

XLDnaute Accro

Pièces jointes

Shou

Guest

DariusBacchus

Guest

FUSIONNER / CONCATENER des DOUBLONS

Ctrl-Alt-Suppr

Guest

erilen

Guest

Pièces jointes

erilen

Guest

gosselien

XLDnaute Barbatruc

erilen

Guest

Pièces jointes

erilen

Guest

erilen

Guest

gosselien

XLDnaute Barbatruc

erilen

Guest

gosselien

XLDnaute Barbatruc

erilen

Guest

Shou

Guest

Pièces jointes

gosselien

XLDnaute Barbatruc

zebanx

XLDnaute Accro

Pièces jointes

Shou

Guest

DariusBacchus

Guest

Privacy & Transparency

Privacy & Transparency