Macro sur 145 000 lignes

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.

Salut VDMICHEL,

Essaye ceci en remplaçant les CELL + Irow par les cellules voulus pour la formule tout en jouant avec l'Irow. (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

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

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 !

Bonsoir Baboutz,

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

Merci

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

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 + !

Je te conseil de suivre également les (très) bons conseils d'Éric !

Bonne soirée à vous deux,

Baboutz

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.

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

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...

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

A+

Il faut combiner les 2 !

avec ceci j'ai 3 secondes !

Sub version_v3()
Dim DataRange As Variant
Dim Irow As Long
Dim Myvar As Variant
Dim Dico As Object
Set Dico = CreateObject("Scripting.Dictionary")
Dico.CompareMode = 1

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

    DataRange = Worksheets("Feuil1").Range("AL2:AL" & Range("B" & Rows.Count).End(xlUp).Row).Value
    For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If Not Dico.exists(Cells(i, "T").Value) Then DataRange(i - 1, 1) = 1 Else DataRange(i - 1, 1) = 0
        Dico(Cells(i, "T").Value) = 1
    Next
    Worksheets("Feuil1").Range("AL2:AL" & Range("B" & Rows.Count).End(xlUp).Row).Value = DataRange

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

End Sub

https://www.cjoint.com/c/ILnh5F7UPGw

Mais j'aime beaucoup l'idée de Baboutz de mettre les formules dans un tableau et de le coller, ce qui évite en effet à excel de mouliner à tout bout de champ.

Désolé, je n'avais pas été au bout des possibilités ...

1 seconde de traitement :

Sub version_v4()
Dim critere As Variant, resultat As Variant, i As Long
Dim Dico As Object
Set Dico = CreateObject("Scripting.Dictionary")
Dico.CompareMode = 1

depart = Now

    critere = Range("T2:T" & Range("B" & Rows.Count).End(xlUp).Row).Value
    ReDim resultat(1 To UBound(critere), 1 To 1)
    For i = 1 To UBound(critere)
        If Not Dico.exists(critere(i, 1)) Then resultat(i, 1) = 1 Else resultat(i, 1) = 0
        Dico(critere(i, 1)) = 1
    Next
    Range("AL2:AL" & Range("B" & Rows.Count).End(xlUp).Row).Value = resultat

MsgBox Format(Now - depart, "hh:mm:ss")

End Sub

Impressionnant Steelson, belle combinaison !

Je ne connait quasiment pas la fonction Dico ainsi que d'autres que tu as utilisé, je vais me pencher là-dessus pour apprendre et comprendre.

Merci !

Bonjour Baboutz, eriic, Steelson et curulis57,

WOW, je me sens comme un jour de Noël!

J'ai testé la V2 de Steelson sur un fichier de 33 500 lignes. Bon pour 22 secondes.

Si j'ai bien compris, la macro donne le résultat de la formule SI(NB.SI($T$1:$T2;$T2)=1;1;0) jusqu'à la dernière ligne non vide.

J'ai mis la macro dans un module, et pour contre vérifier j'ai écris la formule en AM2 pour comparer les résultats de la macro, et à ma grande surprise la formule c'est étendue jusqu'à la dernière ligne non vide sans que j'active la macro!

Est-ce normal?

Est-ce possible aussi d'ajouter cette formule à la macro :SI([@[DESCR_LOGEMENT]]="0000000";0;SI(NB.SI($X$1:X2;$X2)>1;0;1))

Merci pour votre précieuse générosité.

Pourquoi ne pas avoir pris directement la version 4, la plus rapide ?

Il doit être possible en effet de rajouter cette formule, mais il faudrait nous préciser où exactement ? Quelle plage de cellule ?

Bonjour Baboutz,

Ok, je viens d'apprendre que le fichier est en mode tableaux, d'où le drag automatique de tout à l'heure!

La seconde formule en question est

SI([@[DESCR_LOGEMENT]]="0000000";0;SI(NB.SI($X$1:X2;$X2)>1;0;1))

. Et doit se retrouver dans la colonne AK.

Le DESCR_LOGEMENT est le titre qui correspond à la colonne G, les X sont vraiment les colonne X.

Merci encore pour votre temps.

Ce genre de formule

SI(NB.SI($X$1:$X2;$X2)>1;0;1)

se simplifie en utilisant justement dico.scripting. Car il s'agit juste de savoir si une valeur est déjà sortie ou non. Car c'est cela qui est surtout chronophage.

Qui se lance ? c'est l'occasion de tester !

Bonjour Steelson,

la formule exacte est :

SI($G1="000000";0;SI(NB.SI($X$1:X2;$X2)>1;0;1))

pour la colone AK2 jusqu'à la dernière ligne non vide.

Merci beaucoup.

oups, j'ai ajouté l'absolu devant le G

Re,

si tu es en Tableau, y'a-t'il toujours un intérêt à mettre une macro ?

Par définition un tableau s'étend tout seul en mettant formules et formats.

eric