XL 2019 Supprimer contenu plage selon condition

[KTM]

Bonjour chers tous
je voudrais une macro simple qui va vider ma table sauf les données des colonnes "PERTE"
merci .

 

[job75]

Bonsoir KTM,

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

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+

 

[riton00]

Bonsoir à tous

Autre méthode

Slts

 

[KTM]

Bonsoir KTM,

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

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+

Merci Job75
votre méthode avec la boucle , si vous acceptez de me la proposer sera idéale. Ma table se limite a la ligne 30.
Encore merci.

 

[job75]

Bonjour KTM, riton00, le forum,

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

Je la propose :

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+

 

[job75]

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

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.

 

[KTM]

Bonjour KTM, riton00, le forum,

Je la propose :

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+

super !!!

 

[KTM]

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

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.

super !!!

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

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