Supprimer les renvoies chariots inutiles dans la même cellule

[Pexcel]

Bonjour,
j'ai récupéré un base de donnée excel d'une association et une colonne est rempli de cellules avec des renvoies chariots inutiles ..
J'ai fait une boucle qui parcours cellule par cellule pour y mettre de l'ordre...
Il me reste une correction à réalisé et pas des moindre l'ancienne secrétaire est fan des renvoies de chariot le fameux Alt+entrée ou plus communément le Chr(10).

J'arrive à supprimer deux renvoies de chariots qui se suivent :

Cels.Offset(0, 8) = Replace(Cels.Offset(0, 8), Chr(10) & Chr(10), Chr(10))

Mais quand le renvoie de chariot dans cette même cellule est seul sans texte ça se complique et je voudrais pas supprimer les renvoies de chariot de saisie non vides:

Chr(10) ' a supprimer
15/03/2016 : cour de badminton Ce1 Chr(10) ' on garde
17/04/2016 : Initiation de foot en salle Chr(10) ' on garde
Chr(10) ' a supprimer
Chr(10) ' a supprimer
03/05/2016 : Match de Basket Cm1 vs Cm2 Chr(10) ' on garde
Chr(10) ' a supprimer

Si vous avez une solution, je suis preneur parce que là je cale ...
Merci d'avance ! Prenez soin de vous...

 

[Dudu2]

Bonjour,
Quelque chose comme ça ?

Option Explicit

Sub NettoieActiveCell()
    ActiveCell.Value = ValeurCellule(ActiveCell)
End Sub

Sub NettoieActiveSheet()
    Dim Cellule As Range

    For Each Cellule In ActiveSheet.UsedRange
        Cellule.Value = ValeurCellule(Cellule)
    Next Cellule
End Sub

Function ValeurCellule(Cellule As Range) As Variant
    Dim i As Integer
    Dim Bool As Boolean
    Dim Texte As String

    'Init Return Value
    ValeurCellule = Cellule.Value

    If VarType(Cellule.Value) <> vbString Then Exit Function
    If Len(Cellule.Value) = 0 Then Exit Function

    Texte = Cellule.Value
    Bool = True

    'Élimine les doubles Chr(10)
    i = 1
    Do While i <= Len(Texte)
        If Mid(Texte, i, 1) = Chr(10) Then
            If Bool Then
                Texte = Left(Texte, i - 1) & Mid(Texte, i + 1)
                i = i - 1
            Else
                Bool = True
            End If
        Else
            Bool = False
        End If
        i = i + 1
    Loop

    'Élimine le Char(10) de la fin
    If Right(Texte, 1) = Chr(10) Then Texte = Left(Texte, Len(Texte) - 1)
    'MsgBox "<" & Texte & ">"

    'Return Value
    ValeurCellule = Texte

End Function

 

[g.milano]

Bonjour,

En partant du principe qu'il n'y a pas d'espace entre les Chr(10) empiles, il faut prendre en compte l'espace avant le Chr(10) que vous voulez garder : Cels.Offset(0, 8) = Replace(Cels.Offset(0, 8), " " & Chr(10) & Chr(10), Chr(10)). Par contre si un titre que vous voulez garder comporte un chr(10) sans espace, il sera supprimer.
Vous pourriez être plus efficace en faisant une boucle while /wend sur la plage de cellule concernée avec une condition like " " & Chr(10) (tant qu'il y a des espace+chr()10) dans les cellules.

Dans tous les cas, testez cette méthode sur une copie.

Cordialement

 

[jmfmarques]

Bonjour à tous
Histoire de se divertir un peu pour lutter contre les effets du confinement :
voyons ce que ferait ceci (exemple) :

Range("A1").Value = Chr(10) & "blabla blablaa" & Chr(10) & Chr(10) & "blabla blablaa" & Chr(10)
  Range("A1").Value = Replace(WorksheetFunction.Trim(Replace(Replace(Range("A1").Value, " ", Chr(1)), Chr(10), " ")), Chr(1), Chr(10))

 

[Pexcel]

Bonjour Dudu, merci c'est presque bon mais ça n'enlève pas le premier retour de chariot

Chr(10) ' a supprimer<--------------------------------celui là le premier si premier il y a
15/03/2016 : cour de badminton Ce1Chr(10) ' on garde

 

[Pexcel]

Bonjour à tous
Histoire de se divertir un peu pour lutter contre les effets du confinement :
voyons ce que ferait ceci (exemple) :

Range("A1").Value = Chr(10) & "blabla blablaa" & Chr(10) & Chr(10) & "blabla blablaa" & Chr(10)
  Range("A1").Value = Replace(WorksheetFunction.Trim(Replace(Replace(Range("A1").Value, " ", Chr(1)), Chr(10), " ")), Chr(1), Chr(10))

Bonjour JMF,
non il y a pas d'espace

Chr(10) ' a supprimer
15/03/2016 : cour de badminton Ce1Chr(10) ' on garde
17/04/2016 : Initiation de foot en salleChr(10) ' on garde
Chr(10) ' a supprimer
Chr(10) ' a supprimer
03/05/2016 : Match de Basket Cm1 vs Cm2Chr(10) ' on garde
Chr(10) ' a supprimer

 

[jmfmarques]

non il y a pas d'espace

Qu'il y en ait ou non, le code que j'ai montré fait face (qui peut le plus pouvant le moins)
L'as-tu essayé ? (tu devrais)

 

[Pexcel]

C'est bon c'est résolu, en fait là dedans il y avait à boire et à manger !!! du chr10 du 13 et du 10 +13 pfff .
Un grand merci !

 

[Dudu2]

Corrigé

 

[Pexcel]

Qu'il y en ait ou non, le code que j'ai montré fait face (qui peut le plus pouvant le moins)
L'as-tu essayé ? (tu devrais)

Oups j'avais pas vu ... j'essaye

 

[Pexcel]

Slt, essayé mais ça peut pas le faire le blabla n'est jamais pareil sur mon fichier