Problème doublon et fusion

[zabimaru27]

Bonjour,

Voici mon problème,
J'ai une liste excel du type


1 AAA nicolas
1 AAA Robert
1 AAA Benoit
2 BBB Vincent
2 BBB Bob

Le problème est que la mise en forme ne me va pas. En effetchaque ligne correspond à une ligne excel et chaque champs à une cellule unique.

Je souhaiterai arriver à quelque chose comme ça

1 AAA Nicolas
Robert
Benoit
2 BBB Vincent
Bob

En ayant plus qu'une ligne et la liste des noms fusionner dans une seule cellule.

Est ce possible ??

Merci d'avance

 

[zabimaru27]

Re : Problème doublon et fusion

Bonjour,

Voici mon problème,
J'ai une liste excel du type


1 AAA nicolas
1 AAA Robert
1 AAA Benoit
2 BBB Vincent
2 BBB Bob

Le problème est que la mise en forme ne me va pas. En effetchaque ligne correspond à une ligne excel et chaque champs à une cellule unique.

Je souhaiterai arriver à quelque chose comme ça

1 AAA Nicolas
Robert
Benoit
2 BBB Vincent
Bob

En ayant plus qu'une ligne et la liste des noms fusionner dans une seule cellule.

Est ce possible ??

Merci d'avance

Euh désoler , le message à tout décaler, mais les noms sont bien alignés.

 

[job75]

Re : Problème doublon et fusion

Bonjour zabimaru27, bienvenue sur XLD,

Un fichier aurait été le bienvenu aussi, (re)lire la charte du forum.

Voici donc un fichier avec 2 boutons :

- le 1er crée la nouvelle liste sans fusion des cellules

- le 2ème crée la nouvelle liste avec fusion de cellules.

Les macros sont dans Module1 (Alt+F11) et dans le code de la feuille.

Edit 1 : correction : la hauteur de la plage de restitution doit être h - 1.

Edit 2 : les prénoms ne sont pas alignés, je ne sais pas faire autrement - sauf insérer des espaces mais c'est bâtard...

A+

 

[job75]

Re : Problème doublon et fusion

Re,

En utilisant une police de couleur blanche n'est-ce pas mieux (et c'est plus simple) :

Sub Liste()
Dim i&, p%, txt$, j&
Application.ScreenUpdating = False
[B2:B65536].Delete xlUp
For i = 2 To [A65536].End(xlUp).Row
  Cells(i, 2) = Application.Trim(Cells(i, 1)) 'SUPPRESPACE
  p = InStr(InStr(Cells(i, 2), " ") + 1, Cells(i, 2), " ") 'position du 2ème espace
  txt = RTrim(Mid(Cells(i, 2), 1, p))
  j = i
1 j = j + 1
  Cells(j, 2) = Application.Trim(Cells(j, 1)) 'SUPPRESPACE
  If Cells(j, 2) Like txt & "*" Then
    Cells(j, 2).Characters(1, p).Font.ColorIndex = 2 'police couleur blanche
    GoTo 1
  End If
  i = j - 1
Next
End Sub

Les prénoms sont alignés cette fois 🙂

Fichier (2)
A+

 

[job75]

Re : Problème doublon et fusion

Re,

Mal testé 😡 cela n'allait pas s'il n'y avait pas de prénom.

Prenez les fichiers corrigés joints.

A+