IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Optimisation Boucle avec tableau dynamique [XL-2016]


Sujet :

Macros et VBA Excel

  1. #1
    Membre du Club Avatar de Im Dri
    Homme Profil pro
    Responsable Méthodes
    Inscrit en
    avril 2018
    Messages
    64
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Manche (Basse Normandie)

    Informations professionnelles :
    Activité : Responsable Méthodes
    Secteur : Distribution

    Informations forums :
    Inscription : avril 2018
    Messages : 64
    Points : 42
    Points
    42
    Par défaut Optimisation Boucle avec tableau dynamique
    Bonjour à tous,

    Je viens vers vous car j'ai codé une macro qui fonctionne, néanmoins je suis très très loin d'etre un pro de la macro.
    Elle n'est donc pas optimisée, et pour des tableaux de 1000 lignes je dois attendre 20-25 minutes de traitement.

    Je voulais donc savoir s'il existait un moyen d'améliorer le fonctionnement de cette boucle.
    J'ai vu qu'il était possible de passer par des tableaux fictifs, mais je suis incapable de l'adapter a mon propre cas.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
               dernLigne = Cells(Rows.Count, 1).End(xlUp).Row - 1
     
     
                For a = 1 To dernLigne
     
                '___________________________transfert de la reference __________________________________________
                Sheets("ecran utilisateur").Select
                Cells(3, 3).Select
                Selection.Copy
     
                Sheets("archivage").Select
                Cells(Rows.Count, 1).End(xlUp)(2).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.ScreenUpdating = True
     
                '___________________________transfert du statut et du poids enregistre __________________________________________
                Sheets("ecran utilisateur").Select
                Range("C13:k13").Select
                Selection.Copy
                Sheets("archivage").Select
                Cells((Range("A1").End(xlDown).Row), 2).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Cells((Range("A1").End(xlDown).Row), 11).Value = Now
     
                Cells((Range("A1").End(xlDown).Row) + 1, 1).Select
     
                    i = Worksheets("ecran utilisateur").Cells(17, 6).Value
                    Worksheets("ecran utilisateur").Range("C2").Formula = "=archivage!A" & i
                    Worksheets("ecran utilisateur").Cells(17, 6).Value = i + 1
               Next
    Je vous joins également le fichier sur lequel je travaille... (macro du module 4, le bouton situé sur la cellule F18)
    Macro_Definition_Statut_Poids.xlsm
    Si vous avez des idées, je vous en remercie.

    Cdt,
    Adrien

  2. #2
    Membre du Club Avatar de Im Dri
    Homme Profil pro
    Responsable Méthodes
    Inscrit en
    avril 2018
    Messages
    64
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Manche (Basse Normandie)

    Informations professionnelles :
    Activité : Responsable Méthodes
    Secteur : Distribution

    Informations forums :
    Inscription : avril 2018
    Messages : 64
    Points : 42
    Points
    42
    Par défaut
    pour completer mon propos, voici une tentative d'optimisation de ma part : c'ets pas encore la panacée bien que clairement plus rapide.

    le probleme, c'est que pour je ne sais quelle raison, la cellule C13 ne se copie pas alors que toutes les autres fonctionnent


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
       Sub Fonction()
     
                Dim i
                Dim safe As Boolean
                Dim dernLigne As Integer
     
     
                With ThisWorkbook.Worksheets("ecran utilisateur")
                    .Range("C2").Formula = "=archivage!A2"
                    .Range("F17").Formula = "=3"
                    .Range("C4").Formula = "=VLookup(C3, archivage!A:J,4,false)"
                    .Range("C5").Formula = "=VLookup(C3, archivage!A:J,5,false)"
                    .Range("C6").Formula = "=VLookup(C3, archivage!A:J,6,false)"
                    .Range("C7").Formula = "=VLookup(C3, archivage!A:J,7,false)"
                    .Range("C8").Formula = "=VLookup(C3, archivage!A:J,8,false)"
                    .Range("C9").Formula = "=VLookup(C3, archivage!A:J,9,false)"
                    .Range("C10").Formula = "=VLookup(C3, archivage!A:J,10,false)"
     
                End With
     
                dernLigne = Cells(Rows.Count, 1).End(xlUp).Row - 1
     
     
                '___________________________Condition d'activation de la macro __________________________________________
                Sheets("ecran utilisateur").Select
                If Cells(2, 3) = "" Or Cells(3, 3) = "" Or Cells(4, 3) = "" Or Cells(5, 3) = "" Or Cells(6, 3) = "" Or Cells(7, 3) = "" Or Cells(8, 3) = "" Or Cells(9, 3) = "" Then
     
                Else
     
                For a = 1 To dernLigne
     
                '___________________________transfert de la reference __________________________________________
                 'Selection
     
                Sheets("archivage").Cells(Rows.Count, 1).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("C3").Value
                Sheets("archivage").Cells(Rows.Count, 2).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("C13").Value
                Sheets("archivage").Cells(Rows.Count, 3).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("D13").Value
                Sheets("archivage").Cells(Rows.Count, 4).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("E13").Value
                Sheets("archivage").Cells(Rows.Count, 5).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("F13").Value
                Sheets("archivage").Cells(Rows.Count, 6).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("G13").Value
                Sheets("archivage").Cells(Rows.Count, 7).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("H13").Value
                Sheets("archivage").Cells(Rows.Count, 8).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("I13").Value
                Sheets("archivage").Cells(Rows.Count, 9).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("J13").Value
                Sheets("archivage").Cells(Rows.Count, 10).End(xlUp)(2).Value = Sheets("ecran utilisateur").Range("K13").Value
                Sheets("archivage").Cells(Rows.Count, 11).End(xlUp)(2).Value = Now
     
                '___________________________transfert du statut et du poids enregistre __________________________________________
     
     
     
                    i = Worksheets("ecran utilisateur").Cells(17, 6).Value
                    Worksheets("ecran utilisateur").Range("C2").Formula = "=archivage!A" & i
                    Worksheets("ecran utilisateur").Cells(17, 6).Value = i + 1
               Next
     
            End If
    Macro_Definition_Statut_Poids_v1.1.xlsm

  3. #3
    Membre régulier
    Homme Profil pro
    Chargé d'affaire
    Inscrit en
    avril 2022
    Messages
    81
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 34
    Localisation : Belgique

    Informations professionnelles :
    Activité : Chargé d'affaire
    Secteur : Finance

    Informations forums :
    Inscription : avril 2022
    Messages : 81
    Points : 114
    Points
    114
    Par défaut Optimisation
    J'ai simplifié votre code ainsi:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
     
    Sub maFonction()
     
        Dim I, J, k As Integer
        Dim c As Range
        Dim safe As Boolean
        Dim dernLigne, x As Long
        Dim shUtilisateur, shArchivage As Worksheet
        Dim Deb, dur As Date
     
        Deb = Now
        Set shUtilisateur = ThisWorkbook.Worksheets("ecran utilisateur")
        Set shArchivage = ThisWorkbook.Worksheets("archivage")
     
        Application.ScreenUpdating = False
        Application.Cursor = xlWait
        On Error GoTo Sortie
     
        With shUtilisateur
            .Range("C2").Formula = "=archivage!A2"
            .Range("F17") = 3
            For J = 4 To 10
                .Cells(J, 3).Formula = "=VLookup(C3, archivage!A:J," & J & ",False)"
                'Conseil: après entrée des formules, les transformer en valeurs pour gagner en performance !
            Next J
        End With
     
        '___________________________Condition d'activation de la macro _________________________________
        
        With shUtilisateur
            For Each c In shUtilisateur.Range("C2:C10")
                If c.Value = "" Or c.Value = 0 Or WorksheetFunction.IsNA(c) Then
                    MsgBox "La donnée en '" & c.Address & "' est manquante !"
                    Exit Sub
                End If
            Next c
        End With
     
         dernLigne = shArchivage.Cells(Rows.Count, 1).End(xlUp).Row
         x = dernLigne + 1
         With shArchivage
             .Unprotect
     
             For J = 1 To dernLigne
                '___________________________transfert de la reference __________________________________
                .Cells(x, 1).Value = shUtilisateur.Range("C3").Value
                For k = 2 To 11
                    .Cells(x, k).Value = shUtilisateur.Cells(13, k + 1).Value
                Next k
                .Cells(x, 11).Value = Now()
                x = x + 1
                '___________________________transfert du statut et du poids enregistre _________________
                        
                I = shUtilisateur.Cells(17, 6).Value
                shUtilisateur.Range("C2").Formula = "=archivage!A" & I
                shUtilisateur.Cells(17, 6).Value = I + 1
            Next J
        End With

  4. #4
    Membre du Club Avatar de Im Dri
    Homme Profil pro
    Responsable Méthodes
    Inscrit en
    avril 2018
    Messages
    64
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Manche (Basse Normandie)

    Informations professionnelles :
    Activité : Responsable Méthodes
    Secteur : Distribution

    Informations forums :
    Inscription : avril 2018
    Messages : 64
    Points : 42
    Points
    42
    Par défaut
    Bonjour,

    Merci de votre réponse, ca m'est très utile.

    J'ai essayé plusieurs fois votre code, mais cela me retourne différentes erreurs.
    Si je le colle tel quel, je trouve une erreur de compilation au niveau de
    Si j'enleve cette ligne de code, la macro marche parfaitement et me retourne les bons résultats.
    Néanmoins elle ne s'arrête jamais et charge indéfiniment, je suis obligé de fermer excel de force

  5. #5
    Membre du Club Avatar de Im Dri
    Homme Profil pro
    Responsable Méthodes
    Inscrit en
    avril 2018
    Messages
    64
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Manche (Basse Normandie)

    Informations professionnelles :
    Activité : Responsable Méthodes
    Secteur : Distribution

    Informations forums :
    Inscription : avril 2018
    Messages : 64
    Points : 42
    Points
    42
    Par défaut
    c'ets bon, j'ai compris d'ou venait le souci et c'est corrigé.

    Grace a cette macro je mets 1 minute pour traiter 1000 lignes, c'est 20 fois plus rapide, merci beaucoup

  6. #6
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    18 959
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 55
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 18 959
    Points : 55 090
    Points
    55 090
    Billets dans le blog
    128
    Par défaut
    Salut.

    Tu gagnerais déjà à travailler avec des tableaux structurés => https://fauconnier.developpez.com/tu...ux-structures/

    On ne sait pas quelle solution a été trouvée, mais une solution qui traite 1000 lignes à la minute, ce n'est pour moi pas une solution. Dommage.

    Cela dit, au lieu de multiplier les RECHERCHEV, tu aurais intérêt à chercher l'index de la ligne avec un EQUIV puis de t'en servir pour récupérer les données. Ca accélérerait le processus.

    Si tu expliques en français ce que tu souhaites réaliser et que tu place une ou l'autre copie d'écran significative, on pourra probablement t'aider à améliorer le temps de traitement.
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes billets de blog sur DVP
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 0
    Dernier message: 27/03/2020, 20h10
  2. Problème de casting avec tableau dynamique
    Par badoumba dans le forum Langage
    Réponses: 9
    Dernier message: 11/04/2017, 15h11
  3. Recherche Expert pour pb avec tableau dynamique
    Par phippaubert dans le forum Excel
    Réponses: 1
    Dernier message: 21/11/2012, 21h32
  4. realloc avec tableau dynamique ne marche pas
    Par christianf dans le forum Débuter
    Réponses: 2
    Dernier message: 27/07/2010, 14h21
  5. problème avec tableau dynamique
    Par akrobat dans le forum C++
    Réponses: 7
    Dernier message: 28/04/2006, 15h29

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo