Macro qui bugue à chaque fois car fichier trop gros

[samo.m]

Bonjour à tous!
J'ai crée grâce à l'aide d'autres membre une macro me permettant d'alléger mes fichiers trop volumineux (entre 10 et 25 Mo).
Cette macro se charge donc de trouver toutes les cellules qui contiennent "NA" (car cela signifie qu'il n'y a pas de données communiqué) et transforme ces cellules en cellules vierges.
Cette macro fonctionne très bien sur les petits fichiers.
Le problème est que mes fichiers ont un peu moins de 1000 lignes et environs 8000 colonnes (et je suis obligé de garder ce format )
Donc lorsque j'exécute ma macro sur mes fichiers, cela tourne pendant un petit moment et excel cesse de répondre et plante à tous les coups...
Auriez-vous donc une solution afin d'améliorer cette macro et la faire fonctionner sur mes fichiers??

Je vous remercie d'avance et je vous joins ma macro, sait on jamais cela pourra peut être servir à d'autres pas la même occasion

Mon Code :

Public Chemin, Fich As String, ReponseMsgBox As Variant

'                                           .
'routine d'appel depuis le bouton sur feuille
'                                           .
Public Sub SelectionnerRepertoire()
Chemin = FLoadNomDuREP: Chemin = Trim(Chemin): If Chemin = "" Then Exit Sub
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
DoEvents
'demande de confirmation
M$ = "Traiter tous les Fichiers xlsx du répertoire suivant :" & vbLf & Chemin & vbLf & vbLf & "Veuillez confirmer ?"
ReponseMsgBox = MsgBox(M$, vbQuestion + vbYesNo, "Traitement des fichiers")
If ReponseMsgBox = vbYes Then
   BoucleDeTraitement ' appel la routine de traitement des fichiers
   MsgBox "Traitement terminé !", vbInformation
Else
   MsgBox "Traitement abandonné !", vbExclamation
End If
End Sub

' , &H1&)=avec bouton "créer un nouveau dossier" ... , $H201&)=sans le bouton
'objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&, RepDefaut)
Private Function FLoadNomDuREP() As String
Dim objShell As Object, objFolder As Object, REP As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
If Not objFolder Is Nothing Then
   REP = objFolder.Items.Item.Path
   If Right(REP, 1) <> "\" Then REP = REP & "\"
End If
FLoadNomDuREP = REP
Set objShell = Nothing: Set objFolder = Nothing
End Function

'                                                                                         .

Private Sub BoucleDeTraitement()            ' la boucle de traitement des fichiers
Application.ScreenUpdating = False
ChDir Chemin
Fich = Dir(Chemin & "*.xlsx")
Do While Fich <> ""                         ' On effectue la boucle tant qu'il y a un fichier à traiter
  Workbooks.Open Chemin & Fich
  auto_open                                 ' On appel notre macro auto_open
  ActiveWorkbook.Close SaveChanges:=True    ' On ferme le fichier et on sauvegarde les modifications
  Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub

Public Sub auto_open()
Dim resultat As String
resultat = InputBox("Valeur contenue dans cellules à nettoyer", "Nettoyage de cellules")
If resultat <> "" Then
    Application.ScreenUpdating = False
    Cells.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=resultat, Replacement:="", LookAt:=xlWhole, MatchCase:=True
    Application.ScreenUpdating = True
    End If
End Sub

 

[Roland_M]

Re : Macro qui bugue à chaque fois car fichier trop gros

Bonsoir,

pour gagner du temps:
au départ:
Application.ScreenUpdating = False: Application.EnableEvents = False: Application.Calculation = xlCalculationManual

à la fin:
Application.ScreenUpdating = True: Application.EnableEvents = True: Application.Calculation = xlCalculationAutomatic

et surtout dans la boucle de traitement qui est longue mettre :
DoEvents impérativement sinon plantage Excel ne répond plus !