Supprimer doublon avec fusion d'une colonne

[MaxE]

Bonjour,

après quelques recherches sur le forum, je n'arrive pas à trouver un cas similaire au mien. Ne connaissant pas le codage excel, j'en appel à votre aide pour résoudre mon problème. Ou du moins avoir une piste.

Je vous expose le problème.

Nous allons changer de système de gestion commerciale et je dois exporter la base de donnée. Le tout serait facile s'y n'y avait pas les notes à exporter.

Lors de l'export, je sélectionne les champs à prendre en compte : nom société, adresse, tel, fax etc.... et "les notes".
L'export va me créer autant de ligne qu'il y a de notes diférentes. C'est à dire que pour une société qui a 4 notes différentes, et bien je vais me retrouver avec 4 lignes dans mon excel. Toutes les colonnes seront en doublons mais pas la colonne "notes".

La question est donc : comment dédoublonner les lignes de chaque société tout en fusionnant les notes dans une même celulle?

Vu qu'un fihcier vaut mieux qu'une longue explication, il y a un fichier joint.

Pour info, je me retrouve avec plus de 16.000 ligne par commerciaux (et il y en a 5)

Merci pour votre aide.

Bonne journée.

 

[pierrejean]

Bonjour MaxE

Un essai

 

[MaxE]

Bonjour Pierrejean,

merci pour ta réponse. Ça fonctionne sur mon exemple mais pas sur le fichier original. J'ai erreur d'exécution 1004. Erreur définie par l'application ou par l'objet.

Si je regarde la ligne de la macro, celle-ci est en jaune.

Sheets("Feuil2").Range("A2").Resize(UBound(tabres, 1), UBound(tabres, 2)) = tabres

As-tu besoin du fichier original?

MErci

 

[pierrejean]

Re

Effectivement pour debugger il vaut mieux avoir le bon fichier

 

[MaxE]

Ok je t'envoie cela demain.

Merci

 

[pierrejean]

Bonjour BISSON Nicole

 

[MaxE]

Bonjour à vous deux.

j'ai testé mais la macro s'exécute correctement pour les 4 premières sociétés.

Je joins le fichier originale.

Merci pour vos tests

Bonne journée.

 

[gosselien]

Bonjour compatriote de la défense (de Florennes je présume) ,

à mon avis (je viens de tester le code de Nicole) , tu as trop de données pour un "account" , la longueur des data de la colonne 13 (Notes) ne rentre plus dans le tableau provisoire de résultat.

P.

 

[MaxE]

Ralala, je me doutais qu'il y avait trop de données la dedans.

Ce que je vais sans doute faire alors c'est une requête pour sortir moins de notes mais dans un fichier séparé.

Si dans mon fichier séparé j'ai ceci:

ID client ----- Note
45 ----- fghjkl
45 ----- fghjklllllll
569 ----- ghjkluytgh
58 ----- kkkk
58 ----- llllll



Je pourrais relier Les notes sur mon fichier original en fonction de l'ID tout en fusionnant les notes sur une cellule?

Merci


PS: c'est limité à combien de caractères une celulle?

 

[gosselien]

Le contenu d'un cellule ne doit pas dépasser ... ?
Faut trouver ça sur le net, mais déjà dans quelle version d'XL es-tu ?

P.

ps: je viens de lire ceci:

Caractères dans une cellule pouvant être affichés et imprimés
Passent à 32 000. (2010)

https://support.office.com/fr-fr/ar...-à-Excel-1672b34d-7043-467e-8e27-269d656771c3

 

[MaxE]

Ok vais faire ça sur un poste qui a une version plus récente.

Merci et bonne journée.

 

[pierrejean]

Bonjour à tous
Une version qui semble fonctionner ( Excel 2010)
Mais ... le résultat est-il exploitable ????
En plus cela nécessite une bonne dose de patience

Le plus curieux est certainement qu' excel ne m'affiche pas d'erreur sur la version précédente
je réfléchis à une autre solution

NB dans le fichier joint la feuille sans doublons est renseignée

 

[MaxE]

Ah nickel. Chez toi ça fonctionne.
Bon j'ai le choix je vais tester sur un 2013 et un 2016.

Je vous tiens au courant.

Merci

PS: j'étais en 2007

 

[pierrejean]

Re

Une autre macro à tester (demande toujours beaucoup de patience)

Sub report()
tablo = Range("A2:R" & Range("A" & Rows.Count).End(xlUp).Row)
ReDim tabres(1 To UBound(tablo, 1), 1 To UBound(tablo, 2))
ligne = LBound(tabres, 1)
 For m = LBound(tablo, 2) To UBound(tablo, 2)
    tabres(ligne, m) = tablo(LBound(tablo, 1), m)
 Next
For n = LBound(tablo, 1) + 1 To UBound(tablo, 1)
    If tablo(n, 1) <> tablo(n - 1, 1) Then
       ligne = ligne + 1
       For m = LBound(tablo, 2) To UBound(tablo, 2)
           tabres(ligne, m) = tablo(n, m)
       Next
    Else
        tabres(ligne, 13) = tabres(ligne, 13) & Chr(10) & Replace(tablo(n, 13), Chr(10), "")
   End If
Next
Sheets("Sans doublons").Cells.ClearContents
ActiveSheet.Rows(1).Copy Destination:=Sheets("Sans doublons").Rows(1)
For n = LBound(tabres, 1) To UBound(tabres, 1)
    For m = LBound(tabres, 2) To UBound(tabres, 2)
         Sheets("Sans doublons").Cells(n + 1, m) = tabres(n, m)
    Next
Next
'Sheets("Sans doublons").Range("A2").Resize(UBound(tabres, 1), UBound(tabres, 2)) = tabres
Sheets("Sans doublons").Select
End Sub

 

[pierrejean]

Re

Nouvelle version qui concentre un peu les Notes (Patience toujours requise)