Optimisation performance macro

Bonjour la communauté !! 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 !

27ex-macro31.xlsm (20.22 Ko)

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

Merci pour l'info, du coup j'ai changé le message initial

Personne n'a une idée de comment l'optimiser?

Bonsoir

A vérifier si c'est optimisé, car avec 3 lignes, dur dur de chronométrer

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!

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

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!

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

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

Bonjour

Ce qui manque c'est un fichier pour faire des tests

Et pas un fichier avec 3 lignes de données

Un vrai fichier pour faire des tests (pas sur de trouver une solution)

Sarah K a écrit :

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

Rechercher des sujets similaires à "optimisation performance macro"