Macro qui fait grossir fichier

Le 31/01/2019 à 09:24

Bonjour à tous,

J'ai un problème avec une macro et je n'arrive pas à trouver une solution...

je vous explique :

J'ai un bouton "MiseAJour" qui effectue l'enchainement de macro suivant :

Sub RemplissageTableau()
Application.ScreenUpdating = False
Dim c As Range
Dim EffNec

EffNec = "=IF(OR(RC13=""AGPRO"",RC13=""AGTEC"",RC13=""AGING"",RC13=""AGAPP""),0,RC[-2])"

For I = 11 To Sheets.Count
     With Sheets(I)
     .Columns("T:U").ClearContents
        For Each c In .Range("T1:U" & .Range("S" & Rows.Count).End(xlUp).Row)
        c.Formula = EffNec
        Next c
     End With
Next I
Total
End Sub
_____________________________________________________
Sub Total()
Dim LastLig As Long, Deb As Long, Fin As Long
Dim T As Double, U As Double
Dim Prem As String
Dim c As Range

For I = 11 To Sheets.Count
With Sheets(I)
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set c = .Range("B2:B" & LastLig).Find("Total*", LookIn:=xlValues, lookat:=xlPart)
    Deb = 2
    If Not c Is Nothing Then
        Prem = c.Address
        Do
            Fin = c.Row - 1
            .Range("T" & Fin + 1).Formula = "=SUMIF(E" & Deb & ":E" & Fin & ",""<>"",T" & Deb & ":T" & Fin & ")"
            .Range("U" & Fin + 1).Formula = "=SUM(U" & Deb & ":U" & Fin & ")"
            Deb = Fin + 2
            T = T + .Range("T" & Fin + 1)
            U = U + .Range("U" & Fin + 1)
            Set c = .Range("B2:B" & LastLig).FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Prem
    End If
    .Range("T" & LastLig).Resize(, 2) = Array(T, U)
    T = 0
    U = 0
End With
Next I
MiseEnForme
End Sub
_______________________________________________________________
Sub MiseEnForme()

For I = 11 To Sheets.Count
With Sheets(I)
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("E1:E" & LastLig).Copy
    .Range("D1:V" & LastLig).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    '.Columns("A:V").AutoFit
    .Range("A1:Q" & LastLig).HorizontalAlignment = xlLeft
    .Range("T1:U" & LastLig).HorizontalAlignment = xlRight
    .Range("R1:S" & LastLig).EntireColumn.Hidden = True
    .Range("R1:S" & LastLig).EntireColumn.Hidden = True
    .Range("V1:V" & LastLig).ColumnWidth = 40
    .Range("L1:L" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("H1:H" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("O1:O" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("Q1:Q" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("D1:D" & LastLig).EntireColumn.Hidden = True
'Mise en forme Ligne
    .Rows("1:1").HorizontalAlignment = xlCenter
    .Rows("1:1").VerticalAlignment = xlCenter
End With
Next I
End Sub

Tout fonctionne très bien jusqu'à la macro MiseEnForme. Même si celle ci fonctionne, à chaque fois que je l'active, celle ci fait grossir mon fichier, le rendant de plus en plus lent et au final inutilisable.

Sur les conseil d'une personne j'ai rajouté le code suivant, pour voir ou s'exécute la macro:

MsgBox .UsedRange.Address

Et celle ci s'exécute bien dans les dimension voulue...

Je ne sais pas d'où viens le problème et j'ai cherché sans trop trouver de solution convenable. j'ai donc besoin de votre aide

Je suis désolé si je ne me fait mal comprendre ou si mon code est pas lisible ou mal opti, je suis en apprentissage . Si jamais je reformulerai en cas de besoin

Un grand merci d'avance à ceux qui voudrons bien m'aider, je mets en pièce jointe un fichier test avec le problème en question (normalement toutes les feuilles sont utilisé mais le fichier était trop gros pour être mise en pièce jointe)

17test-4.zip (0.97 Mo)
Le 31/01/2019 à 20:04

Bonsoir MaitreBanjo,

J'ai eu beau faire, je n'ai pas trouvé la raison pour laquelle à chaque exécution de "Mise En Forme", le fichier grossissait d'environ 80K.

Il ne semble pas que le code en soit la cause. Plutôt les tables pivots et pour une raison inexplicable.

Une suggestion : si cela est reste compatible avec l'objectif du classeur, le sauvegarder en format "Feuille de calcul OpenDocument (*.ods)", la réduction de taille est importante et l'impact de l'exécution de "Mise en Forme" sur la taille est quasiment nulle...

Le 01/02/2019 à 08:15

Bonjour GVIALLES,

Ce problème est juste incompréhensible...

En tout cas merci d'avoir essayé de m'aider

Je vais aller arpenter d'autre forum en espèrent trouver une solution et si jamais c'est le cas je viendrais la dire ici.

En attendant je vais utiliser ta solution

Merci beaucoup !

Le 01/02/2019 à 11:20

Je pense avoir trouvé d'où viens le problème !

Il s'emblerais que ce soit la mise en forme de la 1ere ligne qui soit la cause du problème :

.Rows("1:1").HorizontalAlignment = xlCenter
    .Rows("1:1").VerticalAlignment = xlCenter

Il faudrais que j'arrive à modifier le code pour dire de A1 à "DernièreColonne"1.

Sauf que je sais pas le faire.

Une âme charitable pour m'aider et m'expliquer ?

Le 01/02/2019 à 11:31

Bonjour,

Je te propose :

.Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count)).HorizontalAlignment = xlCenter
        .Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count)).VerticalAlignment = xlCenter
Le 01/02/2019 à 14:59

Rebonjour,

Merci pour ta réponse

Cela fonctionne mais le fichier continue de grossir... C'est absolument incompréhensible

J'ai trouvé un moyen détourné de "régler" le problème en transformant le code comme ceci :

Sub MiseEnForme()
For I = 11 To Sheets.Count
With Sheets(I)
    .Cells.ClearFormats
End With
Next I

ThisWorkbook.RefreshAll

For I = 11 To Sheets.Count
With Sheets(I)
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("E1:E" & LastLig).Copy
    .Range("D1:V" & LastLig).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    .Columns("A:V").AutoFit
    .Range("A1:Q" & LastLig).HorizontalAlignment = xlLeft
    .Range("T1:U" & LastLig).HorizontalAlignment = xlRight
    .Range("R1:S" & LastLig).EntireColumn.Hidden = True
    .Range("R1:S" & LastLig).EntireColumn.Hidden = True
    .Range("V1:V" & LastLig).ColumnWidth = 40
    .Range("L1:L" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("H1:H" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("O1:O" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("Q1:Q" & LastLig).NumberFormat = "m/d/yyyy"
    .Range("D1:D" & LastLig).EntireColumn.Hidden = True
'Mise en forme Ligne
        .Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count)).HorizontalAlignment = xlCenter
        .Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count)).VerticalAlignment = xlCenter
    'MsgBox .UsedRange.Address
End With
Next I
End Sub

Je supprime toutes les mise en formes avant d'aplliquer à nouveau les mise en forme... Mais si je veux mettre des couleurs sur certaines lignes je dois le faire à chaque mise à jour car celle ci disparaisse ...

Sinon je n'ai qu'à supprimer les deux lignes qui font grossir le fichier et je fais une Mise en forme manuel

Le 01/02/2019 à 15:36

Parfois, les voies d'EXCEL sont impénétrables... mais c'est plutôt rare, il faut le reconnaître.

Bon courage pour la suite...

Rechercher des sujets similaires à "macro qui fait grossir fichier"