Supprimer des lignes sous deux conditions

Le
Lune Rousse
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 ri=
en
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #19918021
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"

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
MichDenis
Le #19919361
À 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" 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"

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
Publicité
Poster une réponse
Anonyme