Microsoft 365 Supprimer des sauts de lignes... mais garder ceux avec du texte !

EricSAM

XLDnaute Nouveau
Bonjour à tous,

Mon problème est assez simple mais je n'ai pas encore réussi à trouver la formule ou l'astuce qui pourrait me le régler ! :)

Je réalise des imports de données traduites dans notre PIM via fichier Excel CSV (textes descriptifs de produits). Le fichier fait dans les 10 000 lignes avec une dizaine de champs différents à remonter.
Avant tout, je contrôle la qualité des données et je me rends comptes que de nombreuses cellules comportent des sauts de lignes situés après les derniers caractères de la cellule.

Je pourrait facilement supprimer tous ces sauts de ligne avec la fonction remplacer en identifier les sauts de ligne (ALT+010) mais ça ne me convient pas malheureusement :
les données étant des traductions, j'ai des sauts de lignes utiles que je souhaite conserver dans les cellules.
J'ai au début pensé qu'un =SUPPRESPACE() pourrait résoudre mon problème mais sans résultat... Ceci n’empêche pas de l'utiliser pour nettoyer un peu les cellules.

Je souhaiterai donc supprimer uniquement les sauts de lignes situés après le dernier caractère de la cellule.
Un exemple de mon problème en pièce jointe illustré avec le texte d'une cellule à importer.

Avez-vous une astuce pour arriver à ce résultat ?

Merci d'avance pour votre aide.
 

Pièces jointes

  • Exemple import NL.xlsx
    8.4 KB · Affichages: 10

job75

XLDnaute Barbatruc
Bonjour EricSAM, sylvanu,

Voyez le fichier .xlsm joint et cette macro (Alt+F11) :
VB:
Sub Epurage()
Dim tablo, ncol%, i&, j%, x$, k%, y$
With ActiveSheet.UsedRange
    tablo = .Resize(.Rows.Count + 1).Formula 'matrice, plus rapide, au moins 2 éléments
    ncol = UBound(tablo, 2)
    For i = 1 To UBound(tablo) - 1
        For j = 1 To ncol
            x = tablo(i, j)
            If Left(x, 1) <> "=" Then 'les formules sont ignorées
                For k = Len(x) To 1 Step -1
                    y = Mid(x, k, 1)
                    If y <> vbLf And y <> vbCr Then tablo(i, j) = Left(x, k): Exit For
                Next k
            End If
    Next j, i
    .Formula = tablo 'restitution
    .Rows.AutoFit 'ajustement hauteurs
End With
End Sub
A+
 

Pièces jointes

  • Epurage(1).xlsm
    17.6 KB · Affichages: 3

EricSAM

XLDnaute Nouveau
Bonjour sylvanu et merci pour ton retour.
Je ne connais pas encore ce que fait la formule proposée mais elle a eu le mérite de ne laisser plus qu'un seul saut de ligne final à ma cellule.

Je l'ai essayé sur une centaine de lignes et j'ai pu noter qu'elle supprimait quelques sauts de lignes dit "importants" situés entre 2 paragraphes dans une même cellule.
J'ai également eu une phrase qui est venue se coller au point de la précédente.

Ce sont des choses voulues par cette fonction ?
Merci

Edit : Merci job75, je vais essayer ça ! :)
 

job75

XLDnaute Barbatruc
Pour tester j'ai copié la cellule A2 sur un tableau 10 x 10000, voyez ce fichier (2).

Il met beaucoup de temps à s'ouvrir et la macro s'exécute chez moi en 95 secondes.

J'ai supprimé l'instruction .Rows.Autofit qui ne sert à rien et augmente la durée du traitement.
 

Pièces jointes

  • Epurage(2).xlsm
    305.6 KB · Affichages: 5

EricSAM

XLDnaute Nouveau
Bonjour, veillez m'excuser pour ce retour tardif.

Merci pour cette nouvelle macro, je l'ai essayé sur un fichier bien plus volumineux et elle semble bien résoudre mes problèmes !

Je reviendrai vers vous une fois sûr du bon résultat.

Pour le moment, je réalise toujours un SUPPRESPACE par la suite et les résultats semblent OK jusque là. :)
 

EricSAM

XLDnaute Nouveau
Bonjour R@chid, merci pour votre proposition.

Malheureusement, cette formule supprime tous les saut de lignes de mes cellules alors que je souhaite conserver les sauts de lignes "utiles" compris entre 2 paragraphes.
Ce sont les sauts de ligne à la fin du dernier paragraphe que je souhaite retirer.

Jusque là la macro de job75 semble remplir cette tache avec l'ajout d'un supprespace par la suite.
 

R@chid

XLDnaute Barbatruc
Bonjour,
2021-04-21_15-21-18.png
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo