Autres Suppression de lignes conditions multiples

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

  • Lignes à Supprimer.xlsx
    26.8 KB · Affichages: 12

job75

XLDnaute Barbatruc
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+
 

job75

XLDnaute Barbatruc
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
 

JBond13600

XLDnaute Junior
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 ?
 

job75

XLDnaute Barbatruc
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+
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 948
Membres
101 849
dernier inscrit
florentMIG