Optimisation de Macro

Le 30/11/2021 à 06:02

Bonjour à tous

Grace à une aide bien précieuse, j'ai pu obtenir ce code. Mais le problème c'est que sur mon fichier de plus de 30 000 Lignes il rame à fond.

Des idées pour m'aider à l'optimiser

Option Base 1
Sub test()
Dim cellule As Range, ind%, ws As Worksheet, Der_Ligne%, D As Object
Set ws = Worksheets("feuil1")
Der_Ligne = ws.Range("A" & Rows.Count).End(xlUp).Row
Dim Tablo
Tablo = ws.Range("A1").CurrentRegion
Set D = CreateObject("Scripting.dictionary")

    For i = 3 To UBound(Tablo)
        ind = CLng(Evaluate("=INDEX(Tableau1[Dates sorties],LARGE(IF(((Tableau1[Clé]=""" & Tablo(i, 1) & """)*(Tableau1[Dates sorties]<>"""")),ROW(Tableau1[Clé])-2),1))"))
        If Not D.exists(Tablo(i, 1)) Then D.Add Tablo(i, 1), ind
    Next i
    Set i = Nothing
Dim tablo2()
ReDim tablo2(D.Count, 1 To 2)
tablo2 = Application.Transpose(Array(D.keys, D.Items))
For Each cellule In ws.Range("C3:C" & Der_Ligne)
    For t = 1 To UBound(tablo2)
    If CLng(cellule.Offset(0, 2)) = tablo2(t, 2) Then cellule.Offset(0, 12) = cellule.Offset(0, 11).Value2
    If CLng(cellule) >= tablo2(t, 2) And cellule.Offset(0, -2) = tablo2(t, 1) Then
    cellule.Offset(0, 12) = cellule.Offset(0, 11).Value2
    End If
    Next t
Next cellule

End Sub

En vous remerciant par avance

Le 30/11/2021 à 06:08

Bonjour,

Sans le classeur on ne va pas pouvoir faire grand chose...

Il faut travailler le dernier For each dans un Array : Tu nous fais tout un show avec des Array et un Dico et tu massacres le final avec des tripatouillages de cellules et d'offset...

A+

Le 30/11/2021 à 09:05

Sans le classeur on ne va pas pouvoir faire grand chose...

4fichier-test1.xlsx (15.93 Ko)

Bonjour

Ci-joint le classeur.

Merci

Le 30/11/2021 à 09:55

Le moins que tu puisses faire c'est de me fournir un classeur ou la macro fonctionne.

Sinon je ne peux rien pour toi.

A+

Le 30/11/2021 à 10:11

Vraiment désolé. Le bug était du à la ligne vide (Ligne 8) dès quon la supprime la macro marche. Je vous joins à nouveau le fichier corrigé

9fichier-test1.xlsx (15.90 Ko)
Le 30/11/2021 à 10:43

Bonjour,

Je précise que je n'ai pas vu votre fichier mais de ce que je comprends du code, vous avez un tableau structuré donc il faut l'intégrer dans le code.

Voici un essai d'adaptation du code (avec le peu que j'ai cru comprendre) en attendant des explications détaillées sur la manipulation (j'ai besoin de comprendre les tests effectués et de connaitre les index des colonnes dans Tableau1 qui importent, notamment celles qui correspondent à des dates) :

Sub test()
with range("Tableau1")
    t = .value2
    For i = lbound(t) To UBound(t)
        ind = CLng(Evaluate("=INDEX(Tableau1[Dates sorties],LARGE(IF(((Tableau1[Clé]=""" & t(i, 1) & """)*(Tableau1[Dates sorties<>"""")),ROW(Tableau1[Clé])-2),1))"))
        If t(i, 5) = ind or t(i, 3) >= ind Then t(i, 15) = t(i, 14)
    Next i
    .columns(15).value2 = application.index(t, , 15)
end with
End Sub

Par ailleurs, il faudrait peut-être renommer la colonne clé car clé sous-entend unicité, ce qui n'est visiblement pas le cas.

Cdlt,

Le 30/11/2021 à 11:03

J'ai toujours la même erreur.

Dans un premier temps moi ce qui me pose problème c'est la colonne L une formule qui se réfère à une ligne vide, c'est plus un tableau Excel : Dans un langage un peu pudique on appelle généralement ça "une usine à gaz"."

De la même manière ta ligne 1 relève du même principe...

Je n'ai pas pris le temps de relire tes précédents messages, mais à priori tu cèdes au travers habituel des débutants : Tu mélanges les données brutes et le résultat à obtenir. Tu confonds le départ et l'arrivée.

Le point de départ c'est les données brutes : Un tableau avec des lignes et des colonnes. Si paramètres il y a, ils ont vocation à résider dans une autre feuille (ou peut-être dans les Noms du Gestionnaire de Noms.)

L'arrivée ou le résultat souhaité c'est rarement dans la même feuille. Pourquoi ? Parce que ce résultat suppose souvent des tas de bricolages, calculs intermédiaires, mises en forme destinées à en faciliter la lecture... Alors oui ton tableau principal peut supporter dans les dernières colonnes quelques formules calculées. Mais pas des formules qui font références à des lignes vides...

Par rapport au code, même les développeurs les plus avertis se soumettent à l'exigence des déclarations.

Option Explicit en tête de module est une saine habitude à prendre : Pour cela cochez définitivement dans VBA : Options > Editeur > Déclaration de variables obligatoires ou alors abstenez vous de macroter...

A+

EDIT : 3GB Oui dans ta boule de cristal tu as bien vu le truc c'est un tableau de frimeur : Ça en a tout juste vaguement l'aspect !

Le 07/12/2021 à 18:24

Voici un essai d'adaptation du code (avec le peu que j'ai cru comprendre) en attendant des explications détaillées sur la manipulation

Bonjour 3GB

Je m'excuse pour le délai de réponse.

Avec ce code, c'est sûr j'ai gagné un temps mon monstre sur mon fichier.

Mais il reste un petit réglage que je ne suis pas arrivé à faire.

J'ai joins le fichier (Un qui marche avec votre code) et à coté j'y ais mis le résultat attendu.

Merci d'avance de vous pencher sur mon cas

Ps: Votre approche est la seule qui ait pris moins de 5 min sur mes 37000 lignes de fichier

10fichier-test1.xlsm (22.66 Ko)
Le 07/12/2021 à 21:24

Bonjour à tous,

Désolé, je n'ouvre pas les fichiers...

Moins de 5 minutes ou quelques secondes ? Déjà, peut-être qu'en mettant temporairement le calcul sur manuel, ça pourrait réduire le temps d'exécution car il est possible que le calcul matriciel entraine un recalcul des fonctions volatiles du fichier. C'est à vérifier, je n'en suis pas sur.

Sub test()
application.calculation = xlcalculationmanual
with range("Tableau1")
    t = .value2
    For i = lbound(t) To UBound(t)
        ind = CLng(Evaluate("=INDEX(Tableau1[Dates sorties],LARGE(IF(((Tableau1[Clé]=""" & t(i, 1) & """)*(Tableau1[Dates sorties<>"""")),ROW(Tableau1[Clé])-2),1))"))
        If t(i, 5) = ind or t(i, 3) >= ind Then t(i, 15) = t(i, 14)
    Next i
    .columns(15).value2 = application.index(t, , 15)
end with
application.calculation = xlcalculationautomatic
End Sub

Ces 2 lignes ne coûtent rien...

Cdlt,

Le 08/12/2021 à 19:06

Désolé, je n'ouvre pas les fichiers...

Bonjour 3GB

Ah je comprends mieux alors; Je vous détaille ici alors mon soucis.

CLng(Evaluate("=INDEX(Tableau1[Dates sorties],LARGE(IF(((Tableau1[Clé]=""" & t(i, 1) & """)*(Tableau1[Dates sorties<>"""")),ROW(Tableau1[Clé])-2),1))"))

Cette formule dans le code, je me suis rendu compte qu'elle ne marche pas. J'ai donc obtenu une formule Excel matricielle qui marche très bien mais le problème c'est que quand je la lance, au bout d'une nuit la formule ne s'exécute pas sur les 37 000 lignes; du coup je me demandais si on ne pouvait pas l'adapter sur la macro optimisée qui je précise prend moins de 5 secondes pour s'exécuter.

Voici la formule :

=SI{NB.SI($A$3:$A7;$A7)>=EQUIV(MAX(FILTER($E:$E;$A:$A=$A7));FILTER($E:$E;$A:$A=$A7);0);$N7;""}

Merci d'avance pour l'aide

Le 09/12/2021 à 00:10

Bonjour relmo,

Mais cette formule a bien marché auparavant ?

Je me rends compte qu'en copiant ton code, j'ai malencontreusement supprimé un crochet fermant. Peux-tu essayer ainsi :

CLng(Evaluate("=INDEX(Tableau1[Dates sorties],LARGE(IF(((Tableau1[Clé]=""" & t(i, 1) & """)*(Tableau1[Dates sorties]<>"""")),ROW(Tableau1[Clé])-ROW(Tableau1[#All])),1))"))

Pour l'autre formule, d'une part elle ne m'est pas familière, n'ayant pas 365. D'autre part, elle serait probablement plus lourde vu qu'elle traite des colonnes entières. En général, il vaut mieux, quand c'est possible, privilégier les formules sur des références dynamiques, comme c'est le cas avec le tableau structuré Tableau1.

Rechercher des sujets similaires à "optimisation macro"