Autres Suppression de lignes conditions multiples

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

JBond13600

XLDnaute Junior
Bonjour le Forum,

Malgré de multiples recherches sur l'ensemble des forums, rien ne correspond à ce que je recherche et m'adresse donc à vous en désespoir de cause.

Les lignes sont à traiter en fonction des valeurs de plusieurs colonnes qui sont au nombre de 9, de la colonne "H" à "P" inclus.

Il y a des lignes dont les colonnes "H" à "P" inclus sont toutes vides
Il y a des lignes où deux ou plusieurs colonnes de "H" à "P" contiennent une valeur, quelle qu'elle soit
Il y a des lignes où il n'y a qu'une seule valeur, quelle qu'elle soit, dans une seule des colonnes de "H" à "P" inclus.

Ce sont ces dernières lignes uniquement que je souhaite conserver.

Autrement dit, je ne souhaiterais conserver que les lignes où il n'y a qu'une seule valeur, qu'elle quelle soit, et qu'elle que soit la colonne de "H" à "P" inclus.

Le nombre de lignes à traiter par feuille est supérieur à 3000.

Excel 2007.

En fichier joint les données d'origine et le résultat attendu.

Un grand merci par avance.
 

Pièces jointes

Bonjour JBond13600,

Plusieurs forums ??? Ceci est pourtant très classique :
VB:
Sub SupprimerLignes()
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    With .Columns(.Columns.Count + 1) 'colonne auxiliaire
        .FormulaR1C1 = "=1/(COUNTA(RC8:RC16)=1)" 'NBVAL
        .Value = .Value 'supprime les formules
        .EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour grouper et accélérer
        On Error Resume Next 'si aucune SpecialCell
        .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les valeurs d'erreur
        .ClearContents 'RAZ
    End With
End With
End Sub
A+
 
sur la feuille active ainsi que sur toutes les feuilles suivantes
Il suffit d'ajouter une boucle :
VB:
Sub SupprimerLignes()
Dim i%
Application.ScreenUpdating = False
For i = ActiveSheet.Index To Sheets.Count
    If TypeName(Sheets(i)) = "Worksheet" Then 's'il y a des feuilles Graphiques
        With Sheets(i).UsedRange
            With .Columns(.Columns.Count + 1) 'colonne auxiliaire
                .FormulaR1C1 = "=1/(COUNTA(RC8:RC16)=1)" 'NBVAL
                .Value = .Value 'supprime les formules
                .EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour grouper et accélérer
                On Error Resume Next 'si aucune SpecialCell
                .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les valeurs d'erreur
                .ClearContents 'RAZ
            End With
        End With
    End If
Next
End Sub
 
Il peut y avoir des données ou non dans les colonnes "H" à "P" inclus. Toutes les colonnes suivantes sont vides.
En revanches les colonnes "A" à "G" contiennent des informations à conserver.

Ton dernier code, dont je te remercie encore, fonctionne-t-il avec les dernières informations que je te livre dans ce présent post ?
 
Bonjour JBond13600,

Ok mais on peut peaufiner.

Si la dernière colonne utilisée se trouve avant la colonne P cette macro évite les références circulaires :
VB:
Sub SupprimerLignes()
Dim i%, ncol%
Application.ScreenUpdating = False
For i = ActiveSheet.Index To Sheets.Count
    If TypeName(Sheets(i)) = "Worksheet" Then 's'il y a des feuilles Graphiques
        With Sheets(i).UsedRange
            ncol = .Columns.Count
            If .Columns(ncol).Column < 16 Then ncol = ncol + 16 - .Columns(ncol).Column
            With .Columns(ncol + 1) 'colonne auxiliaire
                .FormulaR1C1 = "=1/(COUNTA(RC8:RC16)=1)" 'NBVAL
                .Value = .Value 'supprime les formules
                .EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour grouper et accélérer
                On Error Resume Next 'si aucune SpecialCell
                .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les valeurs d'erreur
                .ClearContents 'RAZ
            End With
        End With
    End If
Next
End Sub
A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
25
Affichages
613
Retour