Optimisation programme VBA ! Résolu/Fermé

Question

Bonjour ! Je me permets de poster ce message car j'ai besoin de votre aide. En effet, n'étant pas un expert en VBA, je rencontre quelques difficultés sur un programme qui fonctionne, mais qui prend beaucoup trop de temps pour s'exécuter (entre une et deux heures !). Je m'explique. Je possède deux feuilles Excel. La première, nommée « Copie table types mines » contient près de 50 000 lignes de données et la seconde nommée « RTMP0001 » en contient pour sa part quasiment 10 000 pour faire simple. Or, j'ai dans chacune des deux feuilles une colonne qui contient pour chaque ligne une clé qui est créée à partir de plusieurs cellules de la ligne en question (la marque du véhicule, son identifiant, son type et son poids). Le programme que j'ai créé va alors (pour sa partie principale, celle qui me prend le plus de temps) comparer chaque clé de la feuille « Copie table types mines » avec celles de la feuille « RTMP0001 ». Le programme s'arrête lorsqu'il a trouvé une clé qui correspond parfaitement, ou s'il a bouclé pour toutes les clés du fichier X sans trouver de correspondance et passe ensuite à la clé suivante du fichier Y. On doit normalement retrouver toutes les clés de la feuille « Copie table types mines » dans la feuille « RTMP001 » (en réalité, on en retrouve environ 98%, les 2% manquants provenant d'une donnée manquante pour un véhicule). Si deux clés concordent, le programme met le message « Trouvé ! » dans la colonne à côté de la clé testée, sinon il met le message « Pas trouvé ». Du fait de la longueur des fichiers, le temps nécessaire pour la réalisation du programme complet est juste énorme ! Je ne l'ai d'ailleurs testé pour le moment « que » sur 3000 lignes au maximum, ce qui prend déjà plus de 30 MINUTES !!! Cela s'explique notamment par les nombreuses boucles qui se suivent (do et if surtout). J'ai bien essayé de classer les marques par ordre alphabétique, mais cela ne fait pas gagner beaucoup de temps, ce qui était prévisible... J'en appelle donc à vos connaissances en VBA pour m'aider sur ce programme s'il vous plaît ! J'ai entendu parler des « arrays » (dont je ne sais pas me servir) qui feraient gagner un temps énorme, mais je ne sais pas si cela peut être appliqué à mon problème... Je joins la partie de mon programme (celle qui est TRÈS gourmande en temps) : i = 2 'On incrémente les deux variables qui vont servir à changer de ligne dans les deux feuilles en question. j = 2 'La variable i pour "Copie table types mines" et la j pour "RTMP0001". On part de 2 pour ne pas prendre en compte les en-têtes qui contiennent les intitulés de colonnes. Do 'Lancement d'une boucle répéter While Sheets("Copie table types mines").Cells(i, 3) <> "" 'Tant que la cellule dans la colonne "CLÉ JUSTE" comporte des caractères, le programme rentre dans la boucle. If Sheets("Copie table types mines").Cells(i, 15) = "OUI" Then 'Si, pour la ième cellule, le programme trouve un "OUI" dans la colonne "CLÉ DÉJA TROUVÉE ?", il passe à la clé suivante de la feuille "Copie table types mines" i = i + 1 ' On passe à la clé suivante Else If Sheets("Copie table types mines").Cells(i, 3) = Sheets("RTMP0001").Cells(j, 9) Then 'Si les deux cellules correspondent, le programme va mettre le message "Trouvé" dans la colonne "Correspondance" de la feuille "RTMP0001". Sheets("RTMP0001").Cells(j, 10) = " Trouvé ! " 'Message qui confirme que deux clés concordent. Sheets("Copie table types mines").Cells(i, 15) = " OUI " 'Si deux clés concordent, on place dans la colonne "CLÉ DÉJA TROUVÉE ?" de la feuille "Copie table types mines" un "OUI" afin que la clé ne soit pas retestée. j = j + 1 'On passe à la clé (de la feuille RTMP001) suivante. i = 2 'On réincrémente la variable i pour qu'elle reparte du début des clés de la feuille "Copie table types mines". Else i = i + 1 'On passe à la ligne suivante de la colonne "CLÉ JUSTE" dans la feuille "Copie table types mines". End If End If Wend If Sheets("Copie table types mines").Cells(i, 2) = "" Then ' Si le programme a comparé la cellule en question de la feuille "RTMP0001" et qu'il n'a pas trouvé de correspondance avec une des clés de la feuille "Copie table types mines", il affiche dans la colonne "Correspondance" un message d'erreur If Sheets("RTMP0001").Cells(j, 2) <> "" Then 'Boucle si créer afin d'éviter que la première ligne sans information dans la page "RTMP001" ne contienne le message "Pas trouvé" dans la colonne "COMPARAISON" Sheets("RTMP0001").Cells(j, 10) = " Pas trouvé " 'On place un message qui indique à l'utilisateur (dans la colonne "CLÉ DÉJA TROUVÉE ?")que le programme n'a pas trouvé de concordance pour la clé en question j = j + 1 'On passe à la clé suivante (de la feuille RTMP0001) i = 2 'On réincrémente la variable i pour qu'elle reparte du début des clés de la feuille "Copie table types mines" End If End If Loop Until Sheets("RTMP0001").Cells(j, 2) = "" 'Boucle répétitive qui va voir si dans les deux colonnes "CLÉ JUSTE" et "CLÉ", deux clés concordent. On prend comme condition d'arrêt le fait que la deuxième ligne (Gamme) soit vide et non la première (Type mine), car il existe quelques lignes avec des types mines non renseignés. Merci d'avance pour vos réponses !!!

michel_m · Answer

Bonjour,

sans voir la b^te...

pour joindre une pièce
mettre le classeur ( celui qui a 3000 ignes)sans données confidentielles en pièce jointe sur
https://www.cjoint.com/ 
puis copier l'adresse du lien et la coller dans le message de réponse 

dans ton texte tu parles de 2 feuilles et après de 2 classeurs X et Y : faute de frappe ?
 
enfin
 Je me permets de poster ce message car j'ai besoin de votre aide
en général, sur les forums d'entraide ! :o))

je regarderai demain à la fraiche

michel_m · Answer

en fait les doublons ne sont pas génants mais tu en as dans les 2 feuilles  
j'ai laissé la détection de doublon en commentaires si tu veux les éliminer 

durée du traitement des 50000 lignes environ >=2 secondes toujours avec mon vieux coucou  

le code  

Option Explicit  

Sub comparer_les_clés()  
Dim start As Single  
Dim Derlig As Long, T_ct(), T_tm()  
Dim Dico As Object, Lig As Long, Lig_err As Long  
Dim Cle As String, T_out()  

start = Timer  
'-----Initialisations et passage des données en mémoire RAM  
     With Sheets("Copie table types mines")  
          Derlig = .Columns("C").Find("*", , , , , xlPrevious).Row  
          T_ct = Application.Transpose(.Range("C2:C" & Derlig).Value)  
            
          'création d'un objet dictionary des clés cttm  
          Set Dico = CreateObject("scripting.dictionary")  
          For Lig = 1 To UBound(T_ct)  
               If Not Dico.exists(T_ct(Lig)) Then  
                    Dico.Add T_ct(Lig), ""  
               'Else  
                    'Lig_err = .Columns("I").Find(T_ct(Lig), .Range("I1"), xlValues).Row  
                    'GoTo doublon  
               End If  
           Next  
     End With  
       
     With Sheets("RTMP0001")  
          Derlig = .Columns("I").Find("*", , , , , xlPrevious).Row  
          T_tm = Application.Transpose(.Range("I2:I" & Derlig).Value) 'passage en ram  
        
'---------- recherche clé identique dans Dico à partir de T_tm  
          ReDim T_out(1 To UBound(T_tm))  
          For Lig = 1 To UBound(T_tm)  
               Cle = T_tm(Lig)  
               If Dico.exists(Cle) Then  
                   T_out(Lig) = "Trouvé"  
               Else  
                    T_out(Lig) = "Non Trouvé"  
               End If  
          Next  
            
'------------restitution  
          .Range("J2:J" & UBound(T_out)) = Application.Transpose(T_out)  
      End With  
      Application.ScreenUpdating = True  
      MsgBox "durée du traitement: " & Timer - start & " .sec"  
     Exit Sub  
       
doublon:  
     MsgBox T_tm(Lig) + 1 & " ligne " & Lig & " déjà utilisée ligne " & Lig_err & "!!...", vbCritical  
    
End Sub  
   
   
 Michel

MJGOAT · Answer

Je vous remercie michel, je vais tester ça !

MJGOAT · Answer

J'aurais une dernière petite question si ça ne vous dérange pas michel.

J'aimerais savoir s'il était possible qu'à la place de "Trouvé" ou "Non Trouvé", le programme renvoi dans la ligne en question le nom du modèle du véhicule (type commerce) qui se trouve dans la colonne G de la feuille "Copie table types mines".

Je pense bien que s'il y a un changement a effectué, celui-ci doit se trouver là :

 If Dico.exists(Cle) Then
                   T_out(Lig) = "Trouvé"               Else
                    T_out(Lig) = "Non Trouvé"
               End If

Je ne pense pas que mettre un T_out(lig) = cells de quelque chose fonctionne...

Merci d'avance !

Optimisation programme VBA !

4 réponses

Discussions similaires