XL 2010 Suppression lignes en fonction de la range

Michel_ja

XLDnaute Occasionnel
Bonjour à tous,
j'ai ce petit code qui me permet de supprimer les lignes si le contenu de la cellule en Colonne A est vide.
Je souhaite compléter cette dernière en ajoutant à ce code de supprimer la ligne entière si l'ensemble Icellules de la Colonne C à Colonne R sont vides. Pouvez-vous m'aider ? je reçois le message d'erreur suivant: "erreur d'execution "1004": Impossible d'utiliser cettes commande sur des sélections qui se superposent".
Je crois qu'il faut décaler avec offset....

Merci d'avance.
Michel

Sub TestRangeVide()
Range("A3:A1500").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("C3:R1500").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
 

Lone-wolf

XLDnaute Barbatruc
Bonjour Michel et bonne année :)

VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim plage As Range

Set plage = Range("a1:r" & Range("r" & Rows.Count).End(xlUp).Row)

With plage
.AutoFilter 1, "><", xlAnd
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

.AutoFilter 3, "><", xlAnd
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

.AutoFilter
End With
End Sub
 

job75

XLDnaute Barbatruc
Bonjour Michel_ja, Lone-wolf,

Si la colonne Z n'est pas utilisée on peut s'en servir comme colonne auxiliaire :
Code:
Sub TestRangeVide()
Application.ScreenUpdating = False
With [Z3:Z1500] 'colonne à adapter éventuellement
  .Formula = "=1/(A3<>"""")/SUMPRODUCT(N(C3:R3<>""""))"
  .Value = .Value 'ne conserve que les valeurs
  .EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour accélérer
  On Error Resume Next 'si aucune valeur d'erreur
  .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Value = "" 'RAZ
End With
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub
L'exécution est très rapide.

A+
 

job75

XLDnaute Barbatruc
Re,

Merci Lone-wolf, mes meilleurs vœux à toi aussi.

On n'est pas obligé de se polariser sur la ligne 1500 :
Code:
Sub TestRangeVide()
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
With [Z3].Resize(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row) 'colonne Z à adapter éventuellement
  .Formula = "=1/(A3<>"""")/SUMPRODUCT(N(C3:R3<>""""))"
  .Value = .Value 'ne conserve que les valeurs
  .EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour accélérer
  On Error Resume Next 'si aucune valeur d'erreur
  .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Value = "" 'RAZ
End With
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub
Edit : j'ai ajouté l'instruction au cas où la feuille est filtrée.

A+
 
Dernière édition:

Michel_ja

XLDnaute Occasionnel
Bonsoir les gars, Merci pour votre aide, vos deux derniers codes fonctionnent très bien.
Lone-wolf, sur ton premier code, si je le copie/colle en l'état la macro ne se lance pas. Où commence le nom de la macro, à Private ?
Si je supprime la première phrase du code et ajoute donc un sub NomMacro, elle se lance mais s'arrête sur le message ...."Impossible d'utiliser cettes commande sur des sélections qui se superposent".
Et sinon pour ma culture excel, que fait-on avec la formule .Formula = "=1/(A3<>"""")/SUMPRODUCT(N(C3:R3<>""""))" en colonne Z ?
C'est comme si on calculer qu'il y a des caractères ?

Merci encore à vous.
Michel
 

job75

XLDnaute Barbatruc
Bonjour Michel_ja, Lone-wolf, le forum,

Le tri réalisé par la macro du post #5 classe les lignes en fonction du nombre de cellules remplies.

Si l'on ne veut pas modifier l'ordre initial il faut ajouter la fonction SIGNE dans la formule :
Code:
Sub TestRangeVide()
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
With [Z3].Resize(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row) 'colonne Z à adapter éventuellement
  .Formula = "=1/(A3<>"""")/SIGN(SUMPRODUCT(N(C3:R3<>"""")))"
  .Value = .Value 'ne conserve que les valeurs
  .EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour accélérer
  On Error Resume Next 'si aucune valeur d'erreur
  .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Value = "" 'RAZ
End With
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub
Une remarque enfin : la formule considère les cellules contenant le texte vide "" comme vides.

Bonne journée.
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof