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"...
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
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
ça je comprendsfaire uniquement sur la 1° colonne de mon tableau
ça je ne comprends pas!et une autre alternative si possible bien évidement sur une cellule "A2"
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