XL 2013 Supprimer plusieurs lignes vides dans une cellules

youguybass

XLDnaute Junior
Bonjour
Je voudrais une solutions pour supprimer l'ensemble des lignes vides contenues dans une cellule
Le code que j'ai trouvé ne supprime qu'une seule ligne et non toutes d'un coup
 

Pièces jointes

  • probleme excel (2).xls
    33 KB · Affichages: 8
Solution
Re,

Pour cela, on a fait une procédure qui prend en paramètre la plage sur laquelle on veut faire les remplacements:
Sub SupprimerDoubleRetour(plage As Range)
  • La procédure s'appelle SupprimerDoubleRetour
  • Le paramètre est la plage concernée

Tous les codes sont dans module1:
VB:
Sub Demo()

   ' pour une cellule, B2 en l'occurence
   MsgBox "Pour la cellule B2"
   SupprimerDoubleRetour Sheets("Feuil1").Range("b2")
  
   ' pour la première colonne du tableau structuré qui contient la celulle A1
   MsgBox "Pour la colonne 1 du tableau structuré"
   SupprimerDoubleRetour Sheets("Feuil1").Range("a1").ListObject.DataBodyRange.Columns(1)
  
   ' pour la Feuiille entière
   MsgBox "Pour l'ensemble de la feuille"...
C

Compte Supprimé 979

Guest
Bonjour YouGuyBass

Pour moi c'est un peu plus compliqué qu'une simple ligne de code 🤔

A mettre dans un module, pas besoin que ce soit dans la feuille
VB:
Sub SupLigneVide()
  Dim dLig As Long, Lig As Long
  Dim Ind As Integer, TabCel, sTmp As String
  With ActiveSheet
   ' Dernière ligne remplie de la colonne
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 1 To dLig
      sTmp = ""
      ' Si la cellule n'est pas vide
      If .Range("A" & Lig) <> "" Then
        ' Eclater le contenu dans un tableau en prenant en compte les retours à la ligne
        TabCel = Split(.Range("A" & Lig), vbLf)
        ' Pour chaque indice du tableau
        For Ind = 0 To UBound(TabCel)
         ' Vérifier qu'il contient bien une valeur
          If TabCel(Ind) <> "" Then
            sTmp = sTmp & TabCel(Ind) & vbLf
          End If
        Next Ind
        ' Retranscrire le résultat en supprimant le VbLf de fin
        sTmp = Left(sTmp, Len(sTmp) - 1)
        .Range("B" & Lig).Value = sTmp
      End If
    Next Lig
  End With
End Sub

A+
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @youguybass :),

Essayez:
VB:
Sub Demo()
Dim x, a
   Application.ScreenUpdating = False
   With Sheets("Feuil1")
      For Each x In .UsedRange.Cells
         If Not x.HasFormula Then
            a = x.Value
            Do While InStr(a, Chr(10) & Chr(10)) > 0: a = Replace(a, Chr(10) & Chr(10), Chr(10)): Loop
            x.Value = a
         End If
      Next x
   End With
End Sub

edit : bonjour @BrunoM45 :)
 
Dernière édition:

youguybass

XLDnaute Junior
Merci Mapomme
Le code marche parfaitement bien sur la feuille complète, par contre je souhaiterais le faire uniquement sur la 1° colonne de mon tableau, et une autre alternative si possible bien évidement sur une cellule "A2"

D'avance Merci
 

Pièces jointes

  • probleme excel (2).xlsm
    19.2 KB · Affichages: 4

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Pour cela, on a fait une procédure qui prend en paramètre la plage sur laquelle on veut faire les remplacements:
Sub SupprimerDoubleRetour(plage As Range)
  • La procédure s'appelle SupprimerDoubleRetour
  • Le paramètre est la plage concernée

Tous les codes sont dans module1:
VB:
Sub Demo()

   ' pour une cellule, B2 en l'occurence
   MsgBox "Pour la cellule B2"
   SupprimerDoubleRetour Sheets("Feuil1").Range("b2")
  
   ' pour la première colonne du tableau structuré qui contient la celulle A1
   MsgBox "Pour la colonne 1 du tableau structuré"
   SupprimerDoubleRetour Sheets("Feuil1").Range("a1").ListObject.DataBodyRange.Columns(1)
  
   ' pour la Feuiille entière
   MsgBox "Pour l'ensemble de la feuille"
   SupprimerDoubleRetour Sheets("Feuil1").UsedRange

End Sub

Sub SupprimerDoubleRetour(plage As Range)
Dim x, a
   Application.ScreenUpdating = False
   For Each x In plage.Cells
      If Not x.HasFormula Then
         a = x.Value
         Do While InStr(a, Chr(10) & Chr(10)) > 0: a = Replace(a, Chr(10) & Chr(10), Chr(10)): Loop
         x.Value = a
      End If
   Next x
End Sub
 

Pièces jointes

  • youguybass- Remplacer- v1.xlsm
    29 KB · Affichages: 3

Discussions similaires

Statistiques des forums

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