Vitesse d'exécution de la macro

Bonjour à tous,

Je suis un peut embêter car avec plusieurs tests, plusieurs essais et plusieurs heures de travail sur ma macro, je n'arrive pas à diminuer le temps d'exécutions de celle ci.

le problème étant que il y a 3 boucles et que l'une d'entre elle monte jusqu'à 102 ( la variable D).

J'ai déjà fait un premier essai en remplaçant D par 22 pour évité de perdre trop de temps, et grâce au screenUpdating j'ai diviser ce temps par 6.

Je voudrais donc savoir si vous pouviez m'aider à trouver une application (comme screenUpdating) qui me permettra de gagné du temps d'exécution ou tout simplement simplifier les formule ou la macro.

Merci d'avance :)

Sub Macro1()
'
Application.ScreenUpdating = False
Dim start As Single
'Timer pour temps d'exécution
start = Timer

'copier-coller de la colonne marque
Windows("Extrateur.xlsm").Activate
Sheets("Feuil1").Activate

    D = Range("C2") ' Nb de marque TOTAL
    A0 = 1 'Compteur de boucle
Windows("Lista Applicazioni RAPID modifié _ test.xls").Activate

    B5 = 2 'colonne

Do While A0 < D

    Sheets("Feuil1").Select

    Cells(1, B5).Select 'Nom de la marque
    Range(Selection, Selection.End(xlDown)).Select 'Sélection jusqu'en bas (Ctrl+(flèche du bas))
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("Feuil2").Select 'Collage en inversant ligne-colonne
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Cells.Select
    Columns("C:AZ").Select
    Selection.ColumnWidth = 17.5 'largeur des colonne à 17.5

        Range("B1").Select
        ActiveCell.FormulaR1C1 = "=COUNTIF(Sheet1!C3,RC[-1])"

        Range("B2").Select
        ActiveCell.FormulaR1C1 = "=SUM(RC[1]:RC[50])"

        Range("B3").Select
        ActiveCell.FormulaR1C1 = "=COUNTIF(R[1]C[1]:R[47]C[50],""*"")"

        Range("B4").Select
        ActiveCell.FormulaR1C1 = "=COUNTIF(R[-3]C:R[-3]C[50],""*"")"

    'Définitions des 4 variables
        B1 = Range("B1")    'NB de lignes TOTAL pour la marque
        B2 = Range("B2")    'Somme du Nombre de Type par modèle
        B3 = Range("B3")    'Somme des Types pour la marque
        B4 = Range("B4")    'Somme des modèle dans la marque

    'Application d'une formule pour compter le NB de fois que se répète le modèle dans la marque.
        C = 3 'changement de colonne
        A = 0 'compteur de boucle

        Do While A < B4
        'activation de la boucle temps que A est inférieur à la cellule B4
        Cells(2, C).Select
        ActiveCell.FormulaR1C1 = "=COUNTIFS(Sheet1!C3,R1C1,Sheet1!C4,R[-1]C)" 'Formule pour le NB de fois que se répète le modèle dans la marque
        C = C + 1
        A = A + 1

        Loop

    A = 0 'compteur de boucle
    B = 3 'colonne
    N = 0 'variable
    O = 0 'Ligne
    C = 0 'Ligne dans la formule F
    C0 = 0

        Do While A < B4

        Z = Cells(2, B) 'NB modèle actuel
        S = "=COUNTIF(R4C:R[" & Z & "]C,""*"")" 'Formule pour somme des modèles/marques

        Cells(3, B).Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = S
            N = Cells(3, B)

            Do While N < Z
            F = "=IF(Sheet1!R[" & C + C0 & "]C3=R1C1,IF(Sheet1!R[" & C + C0 & "]C4=R1C,Sheet1!R[" & C & "]C5,0),0)"

            Cells(4 + O, B).Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = F
                M = Cells(4 + O, B)
                'M = Case précédente

            If M <= 0 Then
            C = C + 1
            Else
            Cells(4 + O, B).Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = F
            M = Cells(4 + O, B)
            O = O + 1
            End If

                S = "=COUNTIF(R4C:R[" & Z & "]C,""*"")" 'Formule pour somme des modèles/marques

            Cells(3, B).Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = S
                N = Cells(3, B)

            Loop
        C0 = C
        C = 0
        A = A + 1
        B = B + 1
        O = 0

        Loop
    C0 = 0

    Sheets("Feuil2").Select
    M1 = Range("A1")
    Cells.Select
    Selection.Cut
    With Sheets.Add
    .Name = M1
    End With
    ActiveSheet.Paste
    B5 = B5 + 1
    A0 = A0 + 1
Loop
Application.ScreenUpdating = True
'Affichage du temps d'exécution
MsgBox "durée du traitement: " & Timer - start & " secondes"

End Sub

Bonjour

Quelques idées en passant si tu veux faire des test seraient de sortir les select et activate et les cells(1,B5) de mettre directement le numéro de colonne cells(1,2) ou range("B5")

Adapter les FormulaR1C1 par son équivalent en VBA ou worksheet.function, mais je pige rien au (R[1]C[1]:R[47]C[50] a part que c'est ligne, colonne:ligne, colonne

Si tu mettais tes fichiers avec des infos bidons si possible quelqu'un pourra t'aider pour voir le comportement des datas

bonjour à tous,

Si tu mettais tes fichiers avec des infos bidons si possible quelqu'un pourra t'aider pour voir le comportement des datas

tout à fait d'accord.

Bonjour,

Désolé pour le retard j'ai essayer d'adapter un fichier avec des données bidons mais il faut tout que je réadapte donc je vous l'envois comme tel, juste allégé sinon le fichier ne passe pas.

Merci a vous

Bonjour

ta macro fait référence à 2 fichiers "extracteur.xlsm", - je suppose que c'est le fichier que tu as mis - et "Lista Applicazioni RAPID modifié _ test.xls" qui n'est pas joint.

Extracteur est le fichier sur le qu'elle il y a la macro avec une seule données : "D" qui est le nombres de marque disponible vous pouvez donc le remplacer par 4 vu que j'ai supprimé le reste.

et "Lista Applicazioni RAPID modifié _ test.xls" est le fichier que je vous est envoyé que j'ai renommé.

Je fait les modifications et vous le renvoie désolé, je suis pris par le temps vu que je suis au travail.

Merci

Bonjour,

bien qu'il y ait plein de possibilités d'obtenir ce que tu souhaites sans macro (formules, power query, TCD)

voici une proposition de macro dans fichier joint

Plus long de 3 secondes, pour les 4 marques qu'il y a alors sur 102 sa sera énorme :').

Merci en tous cas .

Et cela fait plusieur fois qu'on me le dis mais je ne sais pas par quoi remplacer ces formules si l'on peut m'aiguiller merci :)

h2so4 qu'elle est cette macro : aargh

:')

Bonjour,

Ce truc est vraiment foireux... Au lieu de nous mettre des fichiers tellement bidon qu'on ne peut rien tester. Mets nous les vrais fichiers avec juste les feuilles concernées par la macro et basta...

Et tu ne mets pas une macro modifiée, bricolée, tu mets une macro capable de faire ce qu'elle doit faire même si elle mets une demi heure.

Après pour le bricolage, on s'en occupe.

A+

Le fichier est trop lourd pour que je puisse vous le joindre.

Il fait 5 567 Ko + le fichier de la macro 183 Ko.

Je n'est pas trafiquer le fichier j'ai juste laissé un dixième des données pour pourvoir vous l''envoyé.

La macro est la même seulement le nom des fichiers utilisé ou le nom des feuilles utilisé qui à était changé.

Donc désolé de vous offensez mais je ne peut pas divulgué toutes les infos non plus et encore moins vous les joindre car ce sont de gros fichiers.

Je n'est pas d'autre solution je fait de mon mieux pour vous passer quelques chose de correct.

Ce n'est pas mon métier à la base je fait ça par plaisir et passion et pour découvrir de nouvelle chose .

Merci

re-bonjour,

Plus long de 3 secondes, pour les 4 marques

Si c'est le cas, le problème ne vient pas de la macro aargh que je t'ai fournie. (.10 sec chez moi).

Ce que tu peux faire sinon c'est de prendre la feuille concerner dans

    Windows("Extrateur.xlsm").Activate
    Sheets("Feuil3").Activate

Ou l'autre je sais plus je me suis perdu.

Et de la coller dans ton classeur test pour voir ce qui se passe si tu ne veux pas balancer les deux fichier en essayant au mieux de modifier ce que tu peux, les informations confidentielle les remplacer par des infos se rapprochant mais factice, ou balancer tes deux fichiers en privée a quelqu'un qui le veut bien

Bonsoir

pour ce qui me concerne ma contribution s’arrête là.

Bonjour,

Pour gagner en temps d'exécution, il faut oublier les appels à la feuille (range, cells) et travailler sur des array. C'est fulgurant ! Il faut donc tout absorber dans un tableau, travailler en mémoire vive et retourner en final sur la feuille.

Mettre en plus des formules cela ne peut que ralentir. Et qu'en plus on peut le faire en final avec un TCD.

On passe généralement de quelques minutes à quelques secondes ! hé oui ...

mais il faudrait juste que tu expliques ce que tu fais avec cette macro et ces fichiers.

Bonjour Steelson,

Rien à voir avec la demande initiale au risque de dévier

Ton post m'intéresse, envie de voir le résultat

je suis en plein dans les array en ce moment sur le site boisgontier

Quand tu dis absorber dans un tableau dans le sens de

sub tableau1()

dim tableau as variant

tableau = range("A1:N..." & ..)

for i = lbound(...) to ubound(...)
next i

end sub

Même si dans le cas présent, même en n'ayant pas compris les fichiers poster, je me demande si PowerQuery serait pas mieux pour aller chercher un fichier extérieur, mais envie de voir ta méthode

Shenzar

Shenzar a écrit :

Rien à voir avec la demande initiale au risque de dévier

J'avoue n'avoir en tous cas pas compris le but de la macro de tristan, mais j'y ai vu des cells et des formules ... si on parle vitesse, il ne faut pas faire d'appel aux feuilles

Shenzar a écrit :

Quand tu dis absorber dans un tableau dans le sens de

sub tableau1()
dim tableau as variant
tableau = range("A1:N..." & ..)
for i = lbound(...) to ubound(...)
next i
end sub

oui, et ensuite reporter le résultat dans la feuille tout à la fin

voici un exemple récent avec pas mal de boucles

https://forum.excel-pratique.com/excel/boucle-for-lente-150715/2#p932735

Bonjour à tous,

Merci pour l'intérêt que vous portais à mon poste je me doute que cela n'est pas facile à comprendre pour mon fichier alors je vais essayer de mieux vous expliquer ceci.

Je travail dans une entreprise de reprogrammation moteur, on fait de l'agricole, automobile et poids lourd. Chaque mois nous recevons une liste d'application, qui nous permet de voir les véhicules sur les qu'elles nous pouvons effectué une reprogrammation.

Il y a 3 types de reprogrammations : poser un boitier additionnel, une cartographie moteur via OBD ou sinon via ouverture calculateur.

Et donc il y à 3 fichiers Excel pour chacune de ces applications, je veux donc en exporter le contenu essentiel pour pouvoir créé un fichier Excel pour le SAV qui nous permettra d'effectuer plus vite ces SAV si nous l'avons déjà rencontré.

J'ai donc déjà une macro pour la mise en page de ces fichiers et là je veux donc trier ces infos pour créé par la suite des tableaux pour des listes ETC...

J'espère que je vous es parut plus claire dans ce post.

Je débute dans Excel VBA et donc quand je créé une macro je l'enregistre pour ensuite la modifier temps bien que mal pour obtenir le résultat voulu, je n'en suis pas a ma première macro en VBA et j'ai essayer de toujours m'en sortir et essaye de publier le moins de chose bête sur ce blog pour ne pas vous faire perdre votre temps.

De ce que j'ai compris il faudrait que j'évite d'appeler des Feuil Excel je vais donc essayer de changer cela.

Pour ce qui serait prêt à sacrifier de leurs temps je suis prêt à envoyé mes 2 fichiers par mail si vous le souhaiter.

Encore merci

Bonjour Tristan,

• si ton code n'est pas trop long et ton fichier pas trop complexe(*) , je veux bien m'y plonger.
• il vaudrait mieux que tu fasses l'effort de l'anonymiser et le simplifier avant de le poster et pouvoir partager la solution

(*) ce n'est pas le temps qui me gêne, mais c'est que parfois les fichiers sont tellement alambiqués qu'on n'y comprend rien, j'espère que ce n'est pas ton cas