Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Supprimer des lignes sous deux conditions

2 réponses
Avatar
Lune Rousse
Bonjour,

J'ai un probl=E8me la proc=E9dure ci-dessous fonctionne correctement si je
la lance deux fois de suite. Si elle n=92est ex=E9cut=E9e qu=92une fois ri=
en
ne se passe.
Un coup de torchon sur l=92inutile, le superflu et l=92encombrant serait
le bienvenu.
Merci de votre aide
Lune Rousse

Sub nettoyage()

'supprimer les lignes des cellules vide de la plage C1:D5100 de la
feuille 1 sous deux conditions.

Dim I As Long
Dim Plage As Range
Sheets("Extract_compar").Select
Set Plage =3D Range("C1:C" & Range("C1").End(xlDown).Row)
For I =3D Plage.Cells.Count To 1 Step -1
If Plage.Cells(I).Value =3D "" Then
Plage.Cells(I).EntireRow.Delete
Else
'si les cellules ne sont pas vide mais si elles ont
'moins de 2 caract=E8res je sup la ligne aussi
If Len(Cells(I, 3)) < 2 Then
Plage.Cells(I).EntireRow.Delete
End If
End If

'a faire : recopier toutes les cellules de la colonne C ci-dessus
'dans la col E de la feuille 2 en dessous de la derni=E8re cellule
pleine
'mettre le fond de la cellule copi=E9e en col E ( travail =E0 faire)en
vert

Next
End Sub

2 réponses

Avatar
MichDenis
Bonjour Lune Rousse,

2 propositions, tu retiens celle que tu veux :

'------------------------------------------
Sub test()
Dim Nb As Long
Dim I As Long
Dim Plage As Range

With Sheets("Extract_compar")
Set Plage = .Range("C1:C" & .Range("C65536").End(xlUp).Row)
Nb = Plage.Cells.Count
End With
'Pour supprimer toutes les lignes si la
'la valeur de la cellule en C est vide
Plage.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'si les cellules ne sont pas vide mais si elles ont
'moins de 2 caractères je sup la ligne aussi

For I = Nb To 1 Step -1
If Len(Plage(I)) < 2 Then
Plage(I).EntireRow.Delete
End If
Next
End Sub
'--------------------------------------------

'L'utilisation du filtre élaboré est beaucoup plus rapide
'si ta plage est moindrement grande !

Exemple de code:
'-----------------------------------------------
Sub test()

Dim Sh As Worksheet
Set Sh = Sheets("Extract_compar")
On Error Resume Next
With Sh
'zone de critère pour le filtre élaboré
'tu choisis 2 cellules vides de ta feuille
.Range("K1") = ""
.Range("K2").Formula = "=Len(C2)<2"
With .Range("C1:C" & .Range("C65536").End(xlUp).Row)
.AdvancedFilter xlFilterInPlace, Sh.Range("K1:K2")
Sh.Range("_FilterDataBase").Offset(1).Resize _
(.Rows.Count - 1).SpecialCells(xlCellTypeVisible). _
EntireRow.Delete
End With
.ShowAllData
End With
End Sub
'-----------------------------------------------


"Lune Rousse" a écrit dans le message de groupe de discussion :


Bonjour,

J'ai un problème la procédure ci-dessous fonctionne correctement si je
la lance deux fois de suite. Si elle n’est exécutée qu’une fois rien
ne se passe.
Un coup de torchon sur l’inutile, le superflu et l’encombrant serait
le bienvenu.
Merci de votre aide
Lune Rousse

Sub nettoyage()

'supprimer les lignes des cellules vide de la plage C1:D5100 de la
feuille 1 sous deux conditions.

Dim I As Long
Dim Plage As Range
Sheets("Extract_compar").Select
Set Plage = Range("C1:C" & Range("C1").End(xlDown).Row)
For I = Plage.Cells.Count To 1 Step -1
If Plage.Cells(I).Value = "" Then
Plage.Cells(I).EntireRow.Delete
Else
'si les cellules ne sont pas vide mais si elles ont
'moins de 2 caractères je sup la ligne aussi
If Len(Cells(I, 3)) < 2 Then
Plage.Cells(I).EntireRow.Delete
End If
End If

'a faire : recopier toutes les cellules de la colonne C ci-dessus
'dans la col E de la feuille 2 en dessous de la dernière cellule
pleine
'mettre le fond de la cellule copiée en col E ( travail à faire)en
vert

Next
End Sub
Avatar
MichDenis
À chaque macro, tu pourrais au tout début de chacune
la ligne de code suivante empêchant le rafraîchissement
de l'écran durant leur exécution.
Application.ScreenUpdating = False

Et à la fin de chacune :
Application.ScreenUpdating = True



"MichDenis" a écrit dans le message de groupe de discussion :
O$
Bonjour Lune Rousse,

2 propositions, tu retiens celle que tu veux :

'------------------------------------------
Sub test()
Dim Nb As Long
Dim I As Long
Dim Plage As Range

With Sheets("Extract_compar")
Set Plage = .Range("C1:C" & .Range("C65536").End(xlUp).Row)
Nb = Plage.Cells.Count
End With
'Pour supprimer toutes les lignes si la
'la valeur de la cellule en C est vide
Plage.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'si les cellules ne sont pas vide mais si elles ont
'moins de 2 caractères je sup la ligne aussi

For I = Nb To 1 Step -1
If Len(Plage(I)) < 2 Then
Plage(I).EntireRow.Delete
End If
Next
End Sub
'--------------------------------------------

'L'utilisation du filtre élaboré est beaucoup plus rapide
'si ta plage est moindrement grande !

Exemple de code:
'-----------------------------------------------
Sub test()

Dim Sh As Worksheet
Set Sh = Sheets("Extract_compar")
On Error Resume Next
With Sh
'zone de critère pour le filtre élaboré
'tu choisis 2 cellules vides de ta feuille
.Range("K1") = ""
.Range("K2").Formula = "=Len(C2)<2"
With .Range("C1:C" & .Range("C65536").End(xlUp).Row)
.AdvancedFilter xlFilterInPlace, Sh.Range("K1:K2")
Sh.Range("_FilterDataBase").Offset(1).Resize _
(.Rows.Count - 1).SpecialCells(xlCellTypeVisible). _
EntireRow.Delete
End With
.ShowAllData
End With
End Sub
'-----------------------------------------------


"Lune Rousse" a écrit dans le message de groupe de discussion :


Bonjour,

J'ai un problème la procédure ci-dessous fonctionne correctement si je
la lance deux fois de suite. Si elle n’est exécutée qu’une fois rien
ne se passe.
Un coup de torchon sur l’inutile, le superflu et l’encombrant serait
le bienvenu.
Merci de votre aide
Lune Rousse

Sub nettoyage()

'supprimer les lignes des cellules vide de la plage C1:D5100 de la
feuille 1 sous deux conditions.

Dim I As Long
Dim Plage As Range
Sheets("Extract_compar").Select
Set Plage = Range("C1:C" & Range("C1").End(xlDown).Row)
For I = Plage.Cells.Count To 1 Step -1
If Plage.Cells(I).Value = "" Then
Plage.Cells(I).EntireRow.Delete
Else
'si les cellules ne sont pas vide mais si elles ont
'moins de 2 caractères je sup la ligne aussi
If Len(Cells(I, 3)) < 2 Then
Plage.Cells(I).EntireRow.Delete
End If
End If

'a faire : recopier toutes les cellules de la colonne C ci-dessus
'dans la col E de la feuille 2 en dessous de la dernière cellule
pleine
'mettre le fond de la cellule copiée en col E ( travail à faire)en
vert

Next
End Sub