Macro très très lente sur 200000 lignes

Résolu/Fermé
Radsgord Messages postés 9 Date d'inscription mardi 4 octobre 2016 Statut Membre Dernière intervention 12 octobre 2016 - 8 oct. 2016 à 23:14
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 12 oct. 2016 à 09:20
Bonsoir à tous,
Je vous expose mon problème de lenteur (approx 45 mn ou plus) à l’exécution d’une macro

Feuille « Retour » Base de donnée, Colonne « A » champs concaténer et Colonne « I » valeur à retourner.
Feuille « Saisie » Feuille de saisie d’infos sur Colonne « I » et sur la colonne « J » formule RechercheV pour récupérer les valeurs de la Colonne « I » de la feuille « Retour »

Mon souci c’est que le calcul de cette formule sur 200 000 lignes est très très long donc dans cette optique je me suis dit qu’une fois les valeurs de la f(x) RechercheV avaient été retournées je pouvais supprimer la f(x) RechercheV et remplacé par sa valeur afin d’éviter le recalcule de ces cellules néanmoins si pas encore de retour laisser la formule en Colonne « J » en attente d’informations dans la base dans la feuille « Retour »
Je ne suis pas sûr de mon code et encore moins de l’optimisation et de l’efficacité de cette syntaxe.

http://www.cjoint.com/c/FJivnPTWFLY

Je vous remercie à tous par avance.
A voir également:

6 réponses

Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
9 oct. 2016 à 07:46
Bonjour,
Je vous suggèrerai d'inverser la façon de faire. En premier lieu copier la formule(colonne i) puis faire une recopie des valeurs, ensuite dans la boucle de test, si "MAJ EN ATTENTE" est rencontré, alors je réécris la formule dans la cellule pour comptabiliser les futures mises à jours.
Ce qui donnerait:
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim Départ As Double, arrivée As Double, Durée As Double
    Dim mn As Long, ms As Long, sd As Long
    Dim i As Long, DernLign As Long
    Dim temps As String
    Dim compteur As Long
    Dim progression  As Long
    
    ProgressBar.Width = 0
    ProgressBar.Visible = False
    compteur = 0
    progression = 0
    CommandButton1.Visible = False
    Lbl_Wait.Visible = True
    Lbl_Maj.Visible = True
    ProgressBar.Visible = True
    Lbl_time.Visible = True
    
    Départ = GetTickCount&
    DernLign = Feuil4.Range("A" & Rows.Count).End(xlUp).Row
    Range("J3:J" & DernLign).FormulaR1C1 = "=IFERROR(IF(OR(RC[-4]=""Pas de Fax"",RC[-4]=0),0,VLOOKUP(C[-9],Retour!C[-9]:C[-1],9,FALSE)),""MAJ EN ATTENTE"")"
    Range("J3:J" & DernLign).Value = Range("J3:J" & DernLign).Value

    For i = 3 To DernLign
        compteur = compteur + 1
        With ActiveSheet
            If Range("J" & i).Value = "MAJ EN ATTENTE" Then
                Range("J" & i).FormulaR1C1 = "=IFERROR(IF(OR(RC[-4]=""Pas de Fax"",RC[-4]=0),0,VLOOKUP(C[-9],Retour!C[-9]:C[-1],9,FALSE)),""MAJ EN ATTENTE"")"
            Else
                progression = progression + 1
                ProgressBar.Width = progression * 1.5
                ProgressBar.Caption = progression & " %"
                arrivée = GetTickCount&
                Durée = arrivée - Départ
                mn = Int(Durée / 1000 / 60)
                sd = Int((Durée / 1000) - (mn * 60))
                ms = Durée - (sd * 1000) - (mn * 1000 * 60)
                temps = mn & ":" & sd & ":" & ms
                Lbl_time.Caption = temps
                DoEvents
            End If
        End With
    Next i
    
    Application.ScreenUpdating = True:
    UsfWait.Height = 185.25
    ProgressBar.Caption = "Traitement terminé"
    CommandButton1.Visible = False
    Lbl_Wait.Visible = False
    CommandButton2.Visible = True
    Lbl_Maj.Visible = False
    Img_goodJob.Visible = True
End Sub

Ce devrait beaucoup plus rapide. J'ai modifié le temps pour ignorer le Bug qui apparaissait, vous n'avez plus qu'à corriger.
A tester
Cdlt
0
Radsgord Messages postés 9 Date d'inscription mardi 4 octobre 2016 Statut Membre Dernière intervention 12 octobre 2016
9 oct. 2016 à 11:39
Bonjour Frenchie83,

Je te remercie de ton intervention je vais tester ta syntaxe et je te fais un retour dans les plus bref délai.
Je vais en profiter pour décortiquer les différentes parties afin de mieux comprendre la rédaction, il n'est pas impossible que je te pose quelques questions pour m'assurer d'une bonne compréhension si tu me le permet ?

Merci pour la réponse.
0
Radsgord Messages postés 9 Date d'inscription mardi 4 octobre 2016 Statut Membre Dernière intervention 12 octobre 2016
10 oct. 2016 à 16:37
Bonjour à tous et à frenchie83,

Je viens de tester le code sur un classeur à 138000 lignes malheureusement la macro tourne 114 ou 115 minutes avant de se terminer.
Jai bien compris que tu as remplacé la formule RechercheV dans les cellules de la colonne "J" par Vlookup en vba
Ai-je mal compris tes modifications ?
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
11 oct. 2016 à 10:59
Bonjour à tous

env 2/10 seconde sur le classeur fourni

Sub ccm_mm()
Dim Derlig As Long, T_cola, T_coli, D_retour As Object
Dim Cptr As Long, Ref As String
Dim T_colf, T_colj

Dim Start As Single

Start = Timer
Application.ScreenUpdating = False

With Sheets("Retour")
Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
T_cola = .Range("A2:A" & Derlig)
T_coli = .Range("I2:I" & Derlig)
Set D_retour = CreateObject("scripting.dictionary")

For Cptr = 1 To UBound(T_cola)
Ref = T_cola(Cptr, 1)
If Not D_retour.exists(Ref) Then: D_retour.Add Ref, T_coli(Cptr, 1)
Next
Set T_cola = Nothing
Set T_coli = Nothing
End With

With Sheets("Saisie")
Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
T_colf = .Range("E3:E" & Derlig)
T_colj = .Range("J3:J" & Derlig)
T_cola = .Range("A3:A" & Derlig)
For Cptr = 1 To UBound(T_colf)
If Not D_retour.exists(T_cola(Cptr, 1)) Then
T_colj(Cptr, 1) = "MAJ EN ATTENTE"
Else
If T_colf(Cptr, 1) = "pas de fax" Or T_colf(Cptr, 1) = 0 Then
T_colj(Cptr, 1) = 0
Else
T_colj(Cptr, 1) = D_retour.Item(T_cola(Cptr, 1))
End If
End If
Next
' a passer en "J3" apres essais
.Range("K3").Resize(UBound(T_colj), 1) = T_colj
.Activate
End With

Application.ScreenUpdating = True
MsgBox "durée: " & Timer - Start & " secondes"


End Sub

0
Radsgord Messages postés 9 Date d'inscription mardi 4 octobre 2016 Statut Membre Dernière intervention 12 octobre 2016
11 oct. 2016 à 19:05
Bonjour Michel,

Merci, je regarde et je teste ton code sur le classeur à plusieurs centaines de milliers de lignes ce soir et je te donne des nouvelles au plus vite. Pourrai-je avoir des commentaires sur les différentes ligne de ton code pour en connaitre toute la subtilité et surtout pouvoir progresser en vba.

Merci pour ta réponse et à très vite.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Radsgord Messages postés 9 Date d'inscription mardi 4 octobre 2016 Statut Membre Dernière intervention 12 octobre 2016
12 oct. 2016 à 07:42
Un très grand Bravo Michel,

Tout simplement bluffant, exceptionnel de rapidité ce code, en lieu et place des 114 ou 122 minutes tout est réaliser en 20 secondes maximum pour le même nombre de lignes.
J'essaye de comprendre le code et surtout l'objet "Objet dictionary" et sa programmation.
J'insiste mais vraiment un très très grand merci à toi.
Je continue de ce pas à faire évoluer mon classeur.

De manière plus globale merci à frenchie83 pour le temps passé et son code que je n'ai pas su appliquer.
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
Modifié par michel_m le 12/10/2016 à 09:32
bonjour,
Merci, je mets des commentaires dès que possible; le principe est que pour un nombre ligne important >=2000, on évite les allers-retours chronophages entre la RAM et la carte graphique (ordi bureautique); pour cela on passe la feuille Excel en RAM en utilisant les variables-tableaux: les AR ne se font plus qu"entre le processeur et la RAM car la bande passante entre les 2 est très rapide.
L'utilisation du dictionary évite une recherche longue dans la colonne (ici A)
puisqu'on demande si la donnée existe dans le dico (clé unique)--> pas de boucle pour trouver la donnée ni traitements si vide et restitution -(item) de la valeur associée à la clé.

20 secondes pour combien de lignes ?

pour l'objet magique dictionary, tu as des explications dans l'aide en ligne de
Microsoft (une erreur sur remove)




 Michel
0