XL 2016 Fichier Excel trop "lourd" aide pour optimisation

[Ragnarr]

Bonjour à tous,



J’arrive au bout d'un projet pour lequel le forum m'a déjà été d'un grand secours.
Je souhaiterai, une nouvelle fois, bénéficier de votre conseil / assistance

nous avons créer un fichier Excel nous permettant le suivi de la maintenance de notre parc roulant.
L’ensemble des formules fonctionnait parfaitement jusqu’à ce qu’on étoffe notre base de données en appliquant les formules sur des milliers de lignes


Le problème que je rencontre est donc que la taille, et le contenu, du fichier Excel que nous avons développé le rendent presque inutilisable.
Le temps de sauvegarde, de modification, traitement, calcul est beaucoup trop long voir bloque littéralement le document.



Après avoir cherché sur le forum j’ai réduit les formules, paramètres et données inutiles.

J’ai ensuite sauvegardé le fichier sous format « xlsb » afin de diminuer un peu sa taille

Je ne sais aujourd’hui comment le rendre plus digeste.

Auriez-vous des pistes ?



Je crois avoir lu que des formules matricielles alourdissaient les documents.

ci dessous un lien vers le projet en question.

merci d'avance pour le temps que vous consacrerez à la lecture de cette demande

Julien



https://mon-partage.fr/f/jqnBIfmA/

 

[Ragnarr]

Re,

je n'avais pas fait attention à cela, je regarde, utilisez la macro du post 10 en attendant.

Aucun soucis ce n'est pas urgent merci pour le suivi

 

[Bernard_XLD]

Re,

voila la correction, à tester

Bien cordialement, @+

Sub Archive()
    Dim DLsaisie%, DLArchives%, Mem_Calculation, Compteur&
    Mem_Calculation = Application.Calculation
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    On Error GoTo Gere_Erreurs
    DLsaisie = Worksheets("Saisie").Range("F65500").End(xlUp).Row   ' dernière ligne de Saisie
    If DLsaisie > 3 Then
        With Worksheets("Archives")
            .Cells(1 + .Range("B65500").End(xlUp).Row, 2).Range("A1:G" & DLsaisie - 3).Value = Worksheets("Saisie").Cells(4, 6).Range("A1:G" & DLsaisie - 3).Value ' copie de la colonne F vers la colonne B
            DLArchives = .Range("B" & .Rows.Count).End(xlUp).Row
        End With
        Worksheets("Saisie").Range("F4:k" & DLsaisie).ClearContents ' effacer tableau de saisie
        With Worksheets("Base de données ")
            .Range("G3").FormulaArray = "=MAX(IF(Archives!R4C2:R" & DLArchives & "C2='Base de données '!RC5,Archives!R4C3:R" & DLArchives & "C3))"
            .Range("H3").FormulaArray = "=MAX(IF(Archives!R4C2:R" & DLArchives & "C2='Base de données '!RC5,Archives!R4C6:R" & DLArchives & "C6))"
            .Range("I3").FormulaArray = "=MAX(IF(Archives!R4C2:R" & DLArchives & "C2='Base de données '!RC5,Archives!R4C5:R" & DLArchives & "C5))"
            .Range("G3:I3").Copy
            .Range("G4:I" & .Range("B" & .Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
        End With
        MsgBox "Archivage terminé.", vbOKOnly + vbInformation
    Else
        MsgBox "Aucune donnée à archiver.", vbOKOnly + vbInformation
    End If
Gere_Erreurs:
    With Application
        .Calculation = Mem_Calculation
        .ScreenUpdating = True
    End With
End Sub

 

[Ragnarr]

testé pendant une semaine et approuvé
tout fonctionne correctement et le temps de réponse est optimal

encore merci