Macro sur 145 000 lignes Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
VDMICHEL
Membre fidèle
Membre fidèle
Messages : 477
Appréciations reçues : 3
Inscrit le : 13 novembre 2013
Version d'Excel : 2003

Message par VDMICHEL » 12 décembre 2019, 20:25

Bonjour cher forum,

j'essaie d'appliquer cette petite macro à un fichier qui a 145 000 lignes, et c'est très long d'exécution (+ de 15 minutes).
Range("AL2").FormulaR1C1 = "=IF(COUNTIF(R1C20:RC20,RC20)=1,1,0)"
Range("AL2").AutoFill Destination:=Range("AL2:AL" & Range("B" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault 'applique la formule jusqu'à la dernière ligne non vide
Est-ce possible de réduire le temps d'exécution de la macro?

Merci à l'avance.
Avatar du membre
Baboutz
Membre fidèle
Membre fidèle
Messages : 412
Appréciations reçues : 32
Inscrit le : 19 avril 2019
Version d'Excel : 2016 FR

Message par Baboutz » 12 décembre 2019, 20:52

Salut VDMICHEL,

Essaye ceci en remplaçant les CELL + Irow par les cellules voulus pour la formule tout en jouant avec l'Irow. :wink: (Je ne sais pas à quelles cellules correspondent R1C20 et RC20)

    Dim DataRange As Variant
    Dim Irow As Integer
    Dim Myvar As Variant
    
    DataRange = Worksheets("Feuil1").Range("AL2:AL" & Range("B" & Rows.Count).End(xlUp).Row).Value
    
    For Irow = 1 To Range("B" & Rows.Count).End(xlUp).Row - 1
        
            Myvar = DataRange(Irow, 1)
            
            Myvar = "=IF(COUNTIF(" & CELL + Irow & ":" & CELL + Irow & "," & CELL + Irow & ")=1,1,0)"
            
            DataRange(Irow, 1) = Myvar
            
    Next Irow
    
    Worksheets("Feuil1").Range("AL2:AL" & Range("B" & Rows.Count).End(xlUp).Row).Value = DataRange
Bonne soirée,

Baboutz
1 membre du forum aime ce message.
Avatar du membre
VDMICHEL
Membre fidèle
Membre fidèle
Messages : 477
Appréciations reçues : 3
Inscrit le : 13 novembre 2013
Version d'Excel : 2003

Message par VDMICHEL » 12 décembre 2019, 21:15

Bonsoir Baboutz,

voici la formule d'origine : =SI(NB.SI($T$1:$T2;$T2)=1;1;0).

Je fais des tests et vous revient!

Bonne soirée
Avatar du membre
Baboutz
Membre fidèle
Membre fidèle
Messages : 412
Appréciations reçues : 32
Inscrit le : 19 avril 2019
Version d'Excel : 2016 FR

Message par Baboutz » 12 décembre 2019, 21:29

Cela donnerai alors :
    Dim DataRange As Variant
    Dim Irow As Integer
    Dim Myvar As Variant
    
    DataRange = Worksheets("Feuil1").Range("AL2:AL" & Range("B" & Rows.Count).End(xlUp).Row).Value
    
    For Irow = 1 To Range("B" & Rows.Count).End(xlUp).Row - 1
        
            Myvar = DataRange(Irow, 1)
            
            Myvar = "=IF(COUNTIF(T" &  Irow & ":T" & 1+ Irow & ",T" & 1 + Irow & ")=1,1,0)"
            
            DataRange(Irow, 1) = Myvar
            
    Next Irow
    
    Worksheets("Feuil1").Range("AL2:AL" & Range("B" & Rows.Count).End(xlUp).Row).Value = DataRange
À essayer !
Avatar du membre
VDMICHEL
Membre fidèle
Membre fidèle
Messages : 477
Appréciations reçues : 3
Inscrit le : 13 novembre 2013
Version d'Excel : 2003

Message par VDMICHEL » 12 décembre 2019, 21:30

Bonsoir Baboutz,

Après vérification, il y a une erreur d'exécution 6, dépassement de capacité!

Merci
Avatar du membre
eriiic
Passionné d'Excel
Passionné d'Excel
Messages : 9'296
Appréciations reçues : 373
Inscrit le : 7 février 2010
Version d'Excel : 2010fr

Message par eriiic » 12 décembre 2019, 23:32

Bonjour à tous,

qulle que soit la façon dont tu colles les formules, tant que ce n'est pas cellule par cellule, il faut laisser le temps aux calculs de se faire.
Tout ce que tu peux faire c'est suspendre les calculs qu'ils soient tous fait à la fin.
Mais sur ton exemple, même pas sûr que tu aies un gros gain.
Avant :
Application.Calculation = xlCalculationManual
après :
Application.Calculation = xlCalculationAutomatic
Désactiver aussi l'écran, là ça risque d'être plus intéressant :
Application.ScreenUpdating = False
Si jamais tu as des MFC, c'est très gourmand et il faudrait les suspendre aussi :
ActiveSheet.EnableFormatConditionsCalculation = False
remettre à true ensuite
eric
En essayant continuellement, on finit par réussir.
Donc plus ça rate, plus on a de chances que ça marche.
(les Shadoks)

En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci
Avatar du membre
Baboutz
Membre fidèle
Membre fidèle
Messages : 412
Appréciations reçues : 32
Inscrit le : 19 avril 2019
Version d'Excel : 2016 FR

Message par Baboutz » 12 décembre 2019, 23:50

Salut Éric !

@VDMICHEL Effectivement, il faut remplacer :
Dim Irow As Integer
Par :
Dim Irow As Long
Le problème est qu'une variable déclaré en Integer ne prend pas des nombres aussi grand que 1450000 et + !
Capture.PNG
Capture.PNG (11.52 Kio) Vu 181 fois
Je te conseil de suivre également les (très) bons conseils d'Éric !

Bonne soirée à vous deux,

Baboutz
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'554
Appréciations reçues : 753
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 13 décembre 2019, 01:02

Bonjour VDMICHEL, Baboutz, eriiic

J'ai eu un cas similaire cette semaine (avec 620.000 lignes) ... ma seule planche de salut a été de passer à mon grand désarroi les calculs dans la macro et les faire à partir d'array. Le traitement est instantané ! Ce n'est pas la première fois que cette solution s'est imposée.

Si tu veux faire un essai de rapidité, poste un fichier avec des valeurs.

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'554
Appréciations reçues : 753
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 13 décembre 2019, 06:10

Re-

je me suis aussi posé la question de la stratégie de calcul.
je suis passé de 11 minutes à 10 secondes sur 100.000 lignes

11 minutes en version v1
Sub versionv1()
' fait en 11 minutes
Dim depart As Date

depart = Now
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Range("AL2").FormulaR1C1 = "=IF(COUNTIF(R1C20:RC20,RC20)=1,1,0)"
Range("AL2").AutoFill Destination:=Range("AL2:AL" & Range("B" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault 'applique la formule jusqu'à la dernière ligne non vide

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox Format(Now - depart, "hh:mm:ss")

End Sub
10 secondes en version v2
Sub version_v2()

depart = Now
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim Dico As Object
Set Dico = CreateObject("Scripting.Dictionary")
Dico.CompareMode = 1

For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
    If Not Dico.exists(Cells(i, "T").Value) Then Cells(i, "AL") = 1 Else Cells(i, "AL") = 0
    Dico(Cells(i, "T").Value) = 1
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox Format(Now - depart, "hh:mm:ss")

End Sub
https://www.cjoint.com/c/ILnfkn3sF1w

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'751
Appréciations reçues : 226
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 13 décembre 2019, 07:01

Salut Steelson,

10", comme la version de Baboutz qui passe par un tableau.
A part l'écriture du code, sur 145.000 lignes, je n'ai pu faire mieux... :lole:

Je m'attendais à ce que Dico soit plus rapide!

8-)
A+
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message