XL 2019 Supprimer contenu plage selon condition

job75 à dit:

Bonsoir KTM,

En supposant que la position des colonnes ne changera jamais c'est simple :

VB:

Sub suppr()
Intersect(Rows("3:" & Rows.Count), Range("A:B,D:H,J:N,P:R")).ClearContents
End Sub

Sinon bien sûr il faut une boucle pour effacer les colonnes sans l'en-tête "PERTE".

A+

Cliquez pour agrandir...

KTM à dit:

votre méthode avec la boucle , si vous acceptez de me la proposer sera idéale.

Cliquez pour agrandir...

Sub suppr()
Dim Ltitre, col%
Ltitre = 2 'ligne des titres
With Feuil1.UsedRange 'CodeName de la feuille à adapter
    For col = 1 To .Columns.Count
        If UCase(.Cells(Ltitre, col)) <> "PERTE" Then .Cells(Ltitre + 1, col).Resize(.Rows.Count - Ltitre).ClearContents
    Next
End With
End Sub

job75 à dit:

Bonjour KTM, riton00, le forum,

Je la propose :

VB:

Sub suppr()
Dim Ltitre, col%
Ltitre = 2 'ligne des titres
With Feuil1.UsedRange 'CodeName de la feuille à adapter
    For col = 1 To .Columns.Count
        If UCase(.Cells(Ltitre, col)) <> "PERTE" Then .Cells(Ltitre + 1, col).Resize(.Rows.Count - Ltitre).ClearContents
    Next
End With
End Sub

A+

Cliquez pour agrandir...

job75 à dit:

Une solution sans boucle donc bien plus rapide s'il y a beaucoup de colonnes :

VB:

Sub suppr()
Dim Ltitre
Ltitre = 2 'ligne des titres
Application.ScreenUpdating = False
With Feuil1.UsedRange 'CodeName de la feuille à adapter
    .Rows(Ltitre).Replace "PERTE", "", xlWhole
    Intersect(.Offset(Ltitre), .Rows(Ltitre).SpecialCells(xlCellTypeConstants).EntireColumn).ClearContents
    .Rows(Ltitre).Replace "", "PERTE"
End With
End Sub

Testé sur un tableau (vide) de 14 400 colonnes :

- macro du post #5 => 1,6 seconde et 0,81 seconde avec Application.ScreenUpdating = False

- cette macro => 0,20 seconde.

Cliquez pour agrandir...

job75 à dit:

Une solution sans boucle donc bien plus rapide s'il y a beaucoup de colonnes :

VB:

Sub suppr()
Dim Ltitre
Ltitre = 2 'ligne des titres
Application.ScreenUpdating = False
With Feuil1.UsedRange 'CodeName de la feuille à adapter
    .Rows(Ltitre).Replace "PERTE", "", xlWhole
    Intersect(.Offset(Ltitre), .Rows(Ltitre).SpecialCells(xlCellTypeConstants).EntireColumn).ClearContents
    .Rows(Ltitre).Replace "", "PERTE"
End With
End Sub

Testé sur un tableau (vide) de 14 400 colonnes :

- macro du post #5 => 1,6 seconde et 0,81 seconde avec Application.ScreenUpdating = False

- cette macro => 0,20 s

Cliquez pour agrandir...