Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

rechercher dans quelles feuilles il y a des filtres, les enlever, puis les remettre

1 réponse
Avatar
Help Me
Bonjour à tous

Tout d'abord je tenais à tous vous remercier pour les aides diverses et
variées, et surtout salvatrices de neophites comme moi.

Je vous contacte aujourd'hui car je suis confronté à un problème récurent.

En effet, grace à une macro de excellabo (merci aux auteurs), je nettoie les
scripts de tous les caracteres cachés présents et alourdissants...
.. MAIS...s'il y a un filtre en cours dans un onglet d'un classeur, cela
nettoie tout y compris ce qui est masqué par un filtre que je souhaite
garder...donc ma question...

Quelqu'un saurait soit modifier cette macro pour que ce qui est masqué par
un filtre ne saute pas, ou alors, saurait la compléter en detectant s'il y a
un filtre avant de nettoyer, puis de le remettre apres ????


MERCIIIIII a vous tous

Michel



Sub Nettoie() 'Laurent Longre mpfe, mise en forme GeeDee
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String,
Avant As Double, plage As Range
On Error Resume Next
Calc = Application.Calculation ' ---- mémorisation de l'état de
recalcul
'------------------------------------------------------------
MsgBox "Pour le classeur actif : " _
& Chr(10) & ActiveWorkbook.FullName _
& Chr(10) & "dans chaque feuille de calcul" _
& Chr(10) & "recherche la zone contenant des données," _
& Chr(10) & "réinitialise la dernière cellule utilisée" _
& Chr(10) & "et optimise la taille du fichier Excel", _
vbInformation, _
"d'après LL par GeeDee@m6net.fr"
'-------------------------------------------------------------
MsgBox "Taille initiale de ce classeur en octets" _
& Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, ActiveWorkbook.FullName
'------------------------------------------------------------
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = True
End With
'-------------------- le traitement
For Each Sht In Worksheets
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address
'-------------------Traitement de la zone trouvée
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
'----------------Suppression des lignes inutilisées
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(,2)
'----------------Suppression des colonnes inutilisées
If Not DCell Is Nothing Then Sht.Range(DCell,
Sht.[IV1]).EntireColumn.Delete
End If
Rien = Sht.UsedRange.Address
End If
ActiveWorkbook.Save
'---------------------Message pour la feuille traitée
MsgBox "Nom de la feuille de calcul :" _
& Chr(10) & Sht.Name _
& Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") &
_
" de la taille initiale", vbInformation, ActiveWorkbook.FullName
Next Sht
'--------------------Message fin de traitement
MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) & _
FileLen(ActiveWorkbook.FullName), _
vbInformation, _
ActiveWorkbook.FullNameActive
'--------------------
Application.StatusBar = False
Application.Calculation = Calc
End Sub

1 réponse

Avatar
isabelle
bonjour Michel,

met cette commande
If Sht.AutoFilterMode Then MsgBox "il y a un filtre"
juste après la ligne :
For Each Sht In Worksheets

isabelle

Bonjour à tous

Tout d'abord je tenais à tous vous remercier pour les aides diverses et
variées, et surtout salvatrices de neophites comme moi.

Je vous contacte aujourd'hui car je suis confronté à un problème récurent.

En effet, grace à une macro de excellabo (merci aux auteurs), je nettoie les
scripts de tous les caracteres cachés présents et alourdissants...
.. MAIS...s'il y a un filtre en cours dans un onglet d'un classeur, cela
nettoie tout y compris ce qui est masqué par un filtre que je souhaite
garder...donc ma question...

Quelqu'un saurait soit modifier cette macro pour que ce qui est masqué par
un filtre ne saute pas, ou alors, saurait la compléter en detectant s'il y a
un filtre avant de nettoyer, puis de le remettre apres ????


MERCIIIIII a vous tous

Michel



Sub Nettoie() 'Laurent Longre mpfe, mise en forme GeeDee
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String,
Avant As Double, plage As Range
On Error Resume Next
Calc = Application.Calculation ' ---- mémorisation de l'état de
recalcul
'------------------------------------------------------------
MsgBox "Pour le classeur actif : " _
& Chr(10) & ActiveWorkbook.FullName _
& Chr(10) & "dans chaque feuille de calcul" _
& Chr(10) & "recherche la zone contenant des données," _
& Chr(10) & "réinitialise la dernière cellule utilisée" _
& Chr(10) & "et optimise la taille du fichier Excel", _
vbInformation, _
"d'après LL par "
'-------------------------------------------------------------
MsgBox "Taille initiale de ce classeur en octets" _
& Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, ActiveWorkbook.FullName
'------------------------------------------------------------
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = True
End With
'-------------------- le traitement
For Each Sht In Worksheets
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address
'-------------------Traitement de la zone trouvée
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
'----------------Suppression des lignes inutilisées
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(,2)
'----------------Suppression des colonnes inutilisées
If Not DCell Is Nothing Then Sht.Range(DCell,
Sht.[IV1]).EntireColumn.Delete
End If
Rien = Sht.UsedRange.Address
End If
ActiveWorkbook.Save
'---------------------Message pour la feuille traitée
MsgBox "Nom de la feuille de calcul :" _
& Chr(10) & Sht.Name _
& Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") &
_
" de la taille initiale", vbInformation, ActiveWorkbook.FullName
Next Sht
'--------------------Message fin de traitement
MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) & _
FileLen(ActiveWorkbook.FullName), _
vbInformation, _
ActiveWorkbook.FullNameActive
'--------------------
Application.StatusBar = False
Application.Calculation = Calc
End Sub