Fichier Obèse

Le
Guy72
Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin ?
Merci de votre aide.
--
Cordialement
Guy
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Patrick BASTARD
Le #17533981
Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien ,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" news:u9k0%
Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin ?
Merci de votre aide.
--
Cordialement
Guy




Guy72
Le #17534051
Bonjour Patrick
J'ai une feuille.
Le fichier fait 2200 Ko
--
Cordialement
Guy

"Patrick BASTARD" message de news: %
Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien ,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" news:u9k0%
Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin
?
Merci de votre aide.
--
Cordialement
Guy







Patrick BASTARD
Le #17534451
Re, Guy72.

Je suis arrêté à la ligne "Next Sht"


"Next Sht" signifie en grand breton : "feuille suivante".

--
Bien ,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" news:ewZVW%
Bonjour Patrick
J'ai une feuille.
Le fichier fait 2200 Ko
--
Cordialement
Guy

"Patrick BASTARD" message de news: %
Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien ,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" news:u9k0%
Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin
?
Merci de votre aide.
--
Cordialement
Guy












JPMonnier
Le #17535081
Bonjour,
Il semble qu'i manque un End If avant Next Sht
--
Cordialement


"Guy72" news:ewZVW%
Bonjour Patrick
J'ai une feuille.
Le fichier fait 2200 Ko
--
Cordialement
Guy

"Patrick BASTARD" message de news: %
Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien ,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" news:u9k0%
Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin
?
Merci de votre aide.
--
Cordialement
Guy











Guy72
Le #17536111
Bonjour JP,
Non ça ne fonctionne pas, ça enlève tout, donc pas fiable.
Merci quand même
--
Cordialement
Guy

"JPMonnier"
Bonjour,
Il semble qu'i manque un End If avant Next Sht
--
Cordialement


"Guy72" news:ewZVW%
Bonjour Patrick
J'ai une feuille.
Le fichier fait 2200 Ko
--
Cordialement
Guy

"Patrick BASTARD" message de news: %
Bonjour, Guy72.

Combien de feuilles dans ton classeur ?

--
Bien ,

Patrick BASTARD
patrick.bastardchezdbmail.com

"Guy72" news:u9k0%
Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en
magasin ?
Merci de votre aide.
--
Cordialement
Guy














michdenis
Le #17536961
Essaie ceci :


Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range
Dim Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation

With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With

For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or _
Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", _
, xlFormulas, , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , xlFormulas, _
, xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell.Offset(, 1), Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub





"Guy72" u9k0%
Bonjour,
Je voulais voir si mon fichier avait besoin d'un régime.
J'avais gardé sous le coude cette macro (je ne sais pas ou je l'ai
récupéré).
Mais ça ne fonctionne pas.
Je suis arrêté à la ligne "Next Sht"

Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub

Pouvez-vous voir ce qui cloche, ou si vous avez la même chose en magasin ?
Merci de votre aide.
--
Cordialement
Guy
michdenis
Le #17536941
Il y a encore une petite coquille sur la procédure transmise.

Correction apportée : ceci devrait fonctionner.

'-------------------------------------------------
Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range
Dim DxCell As Range
Dim Calc As Long, Rien As String

On Error Resume Next
Calc = Application.Calculation

With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With

For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or _
Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", _
, xlFormulas, , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)). _
EntireRow.Clear
Set DCell = Nothing
Set DxCell = Sht.Cells.Find("*", , xlFormulas, _
, xlByColumns, xlPrevious)(2)

If Not DxCell Is Nothing Then
Sht.Range(DxCell.Offset(, 1), Sht.[IV1]). _
EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub
'-------------------------------------------------
Modeste
Le #17536931
Bonsour® Guy72 avec ferveur ;o))) vous nous disiez :

Non ça ne fonctionne pas, ça enlève tout, donc pas fiable.



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 Laurent Longre par GeeDee"
'-------------------------------------------------------------
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("*", , xlFormulas, , 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("*", , xlFormulas, , 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


--
@+
;o)))
Guy72
Le #17537411
Bonjour et Merci Modeste
Là c'est fiable, je passe de 2174ko à 99ko.
Par contre, ça me supprime le format d'une colonne (BK1) et me change les
colonnes la largeur des colonnes de BK1 à CK1.
--
Cordialement
Guy

"Modeste" %23K6YF%
Bonsour® Guy72 avec ferveur ;o))) vous nous disiez :

Non ça ne fonctionne pas, ça enlève tout, donc pas fiable.



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 Laurent Longre par GeeDee"
'-------------------------------------------------------------
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("*", , xlFormulas, , 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("*", , xlFormulas, , 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


--
@+
;o)))
Guy72
Le #17537401
Bonjour et Merci aussi "michdenis"
ça fonctionne, je suis passé de 2174 ko à 93ko (6ko de moins que Modeste).
Parc contre même problème.
ça me supprime le format d'une colonne (BK1) et me change la largeur des
colonnes
de BK1 à CK1.
--
Cordialement
Guy
"michdenis"
Il y a encore une petite coquille sur la procédure transmise.

Correction apportée : ceci devrait fonctionner.

'-------------------------------------------------
Sub Nettoie()
' Macro enregistrée Laurent Longre
Dim Sht As Worksheet, DCell As Range
Dim DxCell As Range
Dim Calc As Long, Rien As String

On Error Resume Next
Calc = Application.Calculation

With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours"
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With

For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or _
Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", _
, xlFormulas, , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)). _
EntireRow.Clear
Set DCell = Nothing
Set DxCell = Sht.Cells.Find("*", , xlFormulas, _
, xlByColumns, xlPrevious)(2)

If Not DxCell Is Nothing Then
Sht.Range(DxCell.Offset(, 1), Sht.[IV1]). _
EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub
'-------------------------------------------------






Publicité
Poster une réponse
Anonyme