Optimisation autofill trop long

Le 06/07/2021 à 10:21

Bonjour,

Je dispose d'une macro VB qui exécute une certaine quantité de sumifs sur une feuille.

Le problème de ce code est que l'Autofill en toute fin de code est énormément long(maximum 15 minutes selon le fichier choisi) et fait même ralentir mon classeur de façon importante.

J'ai essayé d'enlever les Range.Copy, les Application.Screenupdating=False mais rien n'y fait.

Pour des raisons de secret professionnel, je ne peux joindre le fichier en question, mais pour vous expliquer un peu le but du fichier : Le but de cette macro est de calculer le montant en différentes devises pour une quantité d'investissements financiers (La liste des différentes devises se trouve de la cellule H1 à la cellule BM1),pour cela le SUMIFS utilise comme critère la devise cherchée + un autre critère d'identification de l'investissement choisi qui se trouve en colonne G.

Je voudrais donc savoir si quelqu'un aurait une piste pour optimiser au mieux le temps d'exécution de la macro ci-dessous? Pour info, il s'agit de plus ou moins 10 000 cellules à calculer...

Je vous en remercie par avance

Sub laldevise()
Dim plage As Range
Dim i, j As Integer
Dim lastligne As Long
Dim visibleetotal, totaldevise As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
Worksheets("Transpa").AutoFilterMode = False
Worksheets("Inventaire filtré").Activate
Range("G2:G" & Range("A2").End(xlDown).Row).Value = Range("A2:A" & Range("A2").End(xlDown).Row).Value

Feuil4.Cells(2, 4).Formula = "=B2/C2"
lastligne = Range("A900").End(xlUp).Row
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & lastligne)
Feuil4.Cells(2, 8).Formula = "=IF(D2=1,B2,SUMIFS(Transpa!$F$2:$F$" & Worksheets("Transpa").Range("F1000000").End(xlUp).Row & ",Transpa!$G$2:$G$" & Worksheets("Transpa").Range("F1000000").End(xlUp).Row & ",G2,Transpa!$B$2:$B$" & Worksheets("Transpa").Range("F1000000").End(xlUp).Row & ",H$1)*D2)"
For j = 9 To 65
Feuil4.Cells(2, j).Formula = "=IF(D2=1,0,SUMIFS(Transpa!$F$2:$F$" & Worksheets("Transpa").Range("F2").End(xlDown).Row & ",Transpa!$G$2:$G$" & Worksheets("Transpa").Range("F2").End(xlDown).Row & ",G2,Transpa!$B$2:$B$" & Worksheets("Transpa").Range("F2").End(xlDown).Row & ",""" & Feuil4.Cells(1, j).Value & """)*D2)"
Next
Range("H2:BM2").Select
Selection.AutoFill Destination:=Range("H2:BM" & lastligne)
Application.Calculation = xlAutomatic
End Sub

NB : J'avais pensé à faire une sorte de générateur de TCD mais comme chaque ligne de calcul est multipliée par une autre ligne de la feuille, je n'sais pas si c'est possible de le faire

Le 06/07/2021 à 11:13

Bonjour,

Pas simple sans un fichier Puis votre temps s'allonge parce que vous utilisez des formules.

- Feuil4 correspond à quelle feuille ? Inventaire Filtré ou Transpa ?
- Dans vos formules, pourquoi allez vous jusque la ligne 1000000 ?
- Dans le code, vous allez jusque la dernière ligne en colonne A avec Xldown dans la feuille Inventaire filtré. Avez-vous d'autres données en dessous

Cordialement

Le 06/07/2021 à 11:20

Bonjour Dan,

Merci pour votre réponse

-Feuil4 correspond à Inventaire filtré

-Je vais jusqu'à la ligne 1000000 parce que j'importe un fichier, qui peut contenir entre 600 000 et 800 000 lignes avec des trous , raisons pour laquelle je pars de 1 000 000

-Lorsque je vais jusqu'à la dernière ligne en colonne A dans inventaire filtré il n'y pas de données en dessous

Le 06/07/2021 à 11:30
5test-devises.xlsx (39.51 Ko)

Pour que vous puissiez visualiser un peu la feuille dont il s'agit, voici un exemple en fichier joint, malheureusement je ne peux pas remplir tout le classeur à l'identique puisqu'il comporte des données confidentielles.

Cdt

Le 06/07/2021 à 13:45

Merci de votre fichier. A priori je ne vois pas comment réduire votre code. Ce qui le ralenti est uniquement du au fait du calcul lorsque vous remettez le mode en calcul automatique.

Toutefois voici le code un peu remanié

Sub laldevise()
Dim plage As Range
Dim i As Integer
Dim j As Byte
Dim visibleetotal As Long, totaldevise As Long, lastligne As Long

Application.ScreenUpdating = False
Application.Calculation = xlManual
Worksheets("Transpa").AutoFilterMode = False

With Worksheets("Inventaire filtré")
    lastligne = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("G2:G" & lastligne).Value = .Range("A2:A" & lastligne).Value
    .Cells(2, 4).Formula = "=B2/C2"
    .Cells(2, 4).AutoFill Destination:=Range("D2:D" & lastligne)
    .Cells(2, 8).Formula = "=IF(D2=1,B2,SUMIFS(Transpa!$F$2:$F$" & _
    Worksheets("Transpa").Range("F1000000").End(xlUp).Row & ",Transpa!$G$2:$G$" & _
    Worksheets("Transpa").Range("F1000000").End(xlUp).Row & ",G2,Transpa!$B$2:$B$" & _
    Worksheets("Transpa").Range("F1000000").End(xlUp).Row & ",H$1)*D2)"

    For j = 9 To 65
        .Cells(2, j).Formula = "=IF(D2=1,0,SUMIFS(Transpa!$F$2:$F$" & _
            Worksheets("Transpa").Range("F2").End(xlDown).Row & ",Transpa!$G$2:$G$" & _
            Worksheets("Transpa").Range("F2").End(xlDown).Row & ",G2,Transpa!$B$2:$B$" & _
            Worksheets("Transpa").Range("F2").End(xlDown).Row & ",""" & .Cells(1, j).Value & """)*D2)"
    Next j

    .Range("H2:BM2").AutoFill Destination:=.Range("H2:BM" & lastligne)
End With
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

Pour le vérifier :
- mettez un point d'arrêt au niveau de Application.Calculation = xlAutomatic (pour le faire, mettez votre curseur de souris sur la ligne puis appuyer sur F9 sur votre clavier. cela va mettre cette ligne en couleur brune en principe)
- Lancer le code et une fois que le code arrivera sur la ligne, appuyez sur F5 pour continuer.

Cordialement

Rechercher des sujets similaires à "optimisation autofill trop long"