Optimisation performance macro Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
S
Sarah K
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 31 octobre 2014
Version d'Excel : 2010

Message par Sarah K » 31 octobre 2014, 11:41

Bonjour la communauté :D !! Je suis quasi débutante sur Vba et je voudrais juste savoir si l'un de vous à une idée sur comment optimiser le code dans le fichier ci-joint. En fait ce code marche mais lorsque je met des petits intervalles de i=2 à 500 pour la boucle,sinon elle tourne beaucoup trop longtemps et à un moment on est obliger d'utiliser le deboggeur.
Dans le fichier ci joint j'ai fait un exemple de 3 lignes mais le fichier réel à traiter a plus de 15000 lignes, du coup, le code est moins performant.
Au fait l'idée est d'essayer plusieurs combinaison de clés dans une feuille du classeur (cle1 cle2 etc dans la macro), et ne retenir que sur une colonne (de la feuille A3 en rouge) la combinaison de clés existante, la macro teste la validité des clés dans la feuille A7.

Merci à tous pour votre coup de pouce :-) !
Ex macro31.xlsm
(20.22 Kio) Téléchargé 24 fois
Modifié en dernier par Sarah K le 31 octobre 2014, 20:17, modifié 3 fois.
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'690
Appréciations reçues : 5
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 31 octobre 2014, 13:41

Bonjour et bienvenu(e)

Peut-être (sans être sur) qu'avec ton fichier et une explication de ce que tu cherches à faire avec ta macro (exemple(s) à l'appui) aiderait grandement la recherche d'une solution

:joindre: :merci:
S
Sarah K
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 31 octobre 2014
Version d'Excel : 2010

Message par Sarah K » 31 octobre 2014, 16:44

Merci pour l'info, du coup j'ai changé le message initial :-)
S
Sarah K
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 31 octobre 2014
Version d'Excel : 2010

Message par Sarah K » 31 octobre 2014, 18:24

Personne n'a une idée de comment l'optimiser? :( :D
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'690
Appréciations reçues : 5
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 31 octobre 2014, 21:33

Bonsoir

A vérifier si c'est optimisé, car avec 3 lignes, dur dur de chronométrer
Sarah K Optimisation V001.xlsm
(21.65 Kio) Téléchargé 23 fois
S
Sarah K
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 31 octobre 2014
Version d'Excel : 2010

Message par Sarah K » 31 octobre 2014, 22:42

Merci beaucoup Banzai64! le code est plus propre que le mien et légérement plus rapide :-) mais il prend quand même du temps, je pense que c'est le fait de recourir à Set dans la boucle qui fait ralentir mais je ne sais pas comment faire autrement :? ! merci encore!
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'690
Appréciations reçues : 5
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 31 octobre 2014, 23:58

Bonjour

A vérifier aussi
Option Explicit

Sub cles_test()
Dim Cle1 As String
Dim Gpn As String
Dim I As Integer

  Gpn = "_GPN_"

  Sheets("A3").Activate

  Application.ScreenUpdating = False
  With Sheets("A7")
    For I = 2 To 4
      If IsNumeric(Cells(I, 1)) Then
        Cle1 = Cells(I, 26) & Gpn & Cells(I, 1)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 2)) Then
        Cle1 = Cells(I, 26) & Cells(I, 2)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 3)) Then
        Cle1 = Cells(I, 26) & Gpn & Cells(I, 3)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 4)) Then
        Cle1 = Cells(I, 26) & Gpn & Cells(I, 4)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 9)) Then
        Cle1 = Cells(I, 26) & Gpn & Cells(I, 9)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 10)) Then
        Cle1 = Cells(I, 26) & Cells(I, 10)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 25)) Then
        Cle1 = Cells(I, 26) & Cells(I, 25)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Left(Cells(I, 18), 5)) Then
        Cle1 = Cells(I, 26) & Left(Cells(I, 18), 5)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1
      End If
Suite:
    Next I
  End With
End Sub
S
Sarah K
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 31 octobre 2014
Version d'Excel : 2010

Message par Sarah K » 1 novembre 2014, 02:06

Mille fois merci Banzai64!! J'ai re tester le nouveau code il fonctionne mais il prend encore du temps, j'ai du la stopper au bout de 15 mn et il me semble qu'il traitait les lignes 7000 et qqes... du coup je pensais qu'en enlevant les Set ça allait fonctionner, mais la pour le coup je ne voit pas du tout ce qui cloche et qui ralentit la macro... Encore merci!
Avatar du membre
Banzai64
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'690
Appréciations reçues : 5
Inscrit le : 21 novembre 2010
Version d'Excel : 2003 FR (learning 2010 - 2013)

Message par Banzai64 » 1 novembre 2014, 02:42

Bonjour

Une dernière chose à tester, c'est de passer en calcul manuel en début de macro

Voir ce que cela donne avec cette macro modifiée dans ce sens
Option Explicit

Sub cles_test()
Dim Cle1 As String
Dim Rng1 As Range
Dim Gpn As String
Dim I As Integer
Dim ModeCalcul As Integer

  Gpn = "_GPN_"

  Sheets("A3").Activate

  With Application
    .ScreenUpdating = False
    ModeCalcul = .Calculation
    .Calculation = xlCalculationManual
  End With
    
  With Sheets("A7")
    For I = 2 To 4
      If IsNumeric(Cells(I, 1)) Then
        Cle1 = Cells(I, 26) & Gpn & Cells(I, 1)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 2)) Then
        Cle1 = Cells(I, 26) & Cells(I, 2)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 3)) Then
        Cle1 = Cells(I, 26) & Gpn & Cells(I, 3)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 4)) Then
        Cle1 = Cells(I, 26) & Gpn & Cells(I, 4)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 9)) Then
        Cle1 = Cells(I, 26) & Gpn & Cells(I, 9)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 10)) Then
        Cle1 = Cells(I, 26) & Cells(I, 10)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Cells(I, 25)) Then
        Cle1 = Cells(I, 26) & Cells(I, 25)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
      End If

      If Not IsError(Left(Cells(I, 18), 5)) Then
        Cle1 = Cells(I, 26) & Left(Cells(I, 18), 5)
        If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1
      End If
Suite:
    Next I
  End With
  Application.Calculation = ModeCalcul
End Sub
S
Sarah K
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 31 octobre 2014
Version d'Excel : 2010

Message par Sarah K » 1 novembre 2014, 13:22

Super!! Merci Banzai64! je viens de tester le calcul manuel, ça va largement plus vite environ 3 minutes pour traiter les 10000 lignes!! Merci encore, si je trouve un truc encore plus rapide j'actualiserai sur le forum :-)
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message