Optimisation programme VBA !

Résolu/Fermé
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 - 13 mai 2013 à 14:45
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 - 17 mai 2013 à 11:11
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 !!!

4 réponses

michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
Modifié par michel_m le 14/05/2013 à 14:58
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
1
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 10
15 mai 2013 à 08:44
Bonjour michel !

Un grand MERCI, le programme fonctionne très bien, on passe de plus d'une heure de programme à moins d'une seconde, c'est énorme !

J'aurais juste deux demandes à vous faire si cela ne vous gène pas trop :

- Le programme ne traite pas la dernière ligne du fichier RTMP0001. Existe-t-il une solution pour résoudre ce problème?

- J'ai essayé de comprendre le programme mais je n'y suis pas arrivé, et ce malgré vos quelques commentaires (mes notions en VBA ne sont pas assez poussées hélas...). Pourriez-vous, si ce n'est pas trop vous demandez, ajouter quelques commentaires supplémentaire afin de me permettre de mieux le comprendre?


P.S. : Je vous remercie une nouvelle fois pour votre aide !
0
michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
Modifié par michel_m le 15/05/2013 à 12:26
Bonjour

Content pour toi (et aussi pour moi !!!) plus dune heure à moins d'une seconde; pas mal mais, hélas pour toi, tu n'auras plus le temps d'inviter la charmante petite stagiaire du secrétariat à boire un café (et peut-ê^tre + si affinités...)
:o)

bon, sérieux !

Le programme ne traite pas la dernière ligne du fichier RTMP0001. Existe-t-il une solution pour résoudre ce problème?

c'est rectifié.
J'en ai profité pour désactiver le chrono en le passant en commentaires et arranger 2 ou 3 trucs
les modifs sont en gras

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 'essai de rapidité
'-----Initialisations et passage des données en mémoire RAM
Application.ScreenUpdating = False
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")
.Range("J2:J50000").ClearContents
Derlig = .Columns("I").Find("*", , , , , xlPrevious).Row
T_tm = Application.Transpose(.Range("I2:I" & Derlig + 1).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</code>

Pour des explications, je te répondrai dans l'après-midi
0
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 10
15 mai 2013 à 15:09
Niquel, ça marche bien pour la dernière ligne ! Encore merci :) !!!
0
michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
Modifié par michel_m le 15/05/2013 à 15:32
Pour commencer, taper un A à l'écran demande + de 100 instructions binaires dues au aller et retour entre les composants et des vitesses des composants moins importantes que le coeur du processeur ( la vitesse est onéreuse et fait chauffer l'ordi)

Tu peux donc imaginer le nombre d'instructions pour lire une cellule Excel et aussi beaucoup plus pour y écrire
Le pire étant les "select-selection" et "copy-paste" car il faut mémoriser la ou les cellules avec tous ses paramêtres: adresse, valeur, format, formule etc.
Plus il y a d'instructions, plus la réponse est longue à formuler...ce qui explique grossièrement la lenteur de ton code sans compter qu'avec 50000 lignes, on peut penser qu'il utilise peut-être la mémoire virtuelle sur le disque dur, d'où nouveau ralentissement

Sur des petits tableaux cela nous parait heureusement instantané vu les bandes passantes des ordis modernes
Ce qui n'emp^che pas de figer le déplacement de l'écran (rapidité, confort) par l'instruction
Application.screenupdating=False


Sur des grands tableaux, l'astuce consiste à envoyer les tableaux Excel en mémoire RAM et à traiter les calculs par des aller-retour entre le processeur et la RAM sans passer par la carte graphique

Pour cela VBA possède l'outil "variable- tableau"; c'est ce qui est fait dans notre problème par une seule ligne
Derlig = .Columns("C").Find("*", , , , , xlPrevious).Row
          T_ct = Application.Transpose(.Range("C2:C" & Derlig).Value)

L'avantage est qu'on ne boucle pas d'où gain de temps

Un autre outil est le dictionnaire -dictionary - qui crée une collection de données sans doublon (key) et un item au choix pour chaque occurrence . (par exemple le code Insee des communes est unique et une commune appartient à un département
Donc on écrirait dico.add insee, departement)

Pour gagner du temps, on ne va pas utiliser les cellules excel mais le tableau T_ct pour remplir notre dico

For Lig = 1 To UBound(T_ct)
               If Not Dico.exists(T_ct(Lig)) Then
                    Dico.Add T_ct(Lig), ""
               End If
           Next
     End With


Ensuite on va parcourir le tableau T_tm de la page RTM en testant si le contenu de chaque élément est dans le dico, et remplir un nouveau tableau de sortie (T_out) avec la réponse "trouvé" ou "non trouvé"

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


Ce tableau est restitué dans la feuille dans la colonne J

.Range("J2:J" & UBound(T_out)) = Application.Transpose(T_out)


Ainsi, on est sorti d'excel en quelque sorte et on a travaillé sur un tableur virtuel ( c'est une image).
conclusion: on passe d'une heure à 1 seconde. gain:3600

Quelques lectures pour approfondir et voir les détails de syntaxe : ubound, redim

Dictionary:
voir l'Aide en ligne

Variables-tableaux (et autres tutos précieux)
https://silkyroad.developpez.com/
0
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 10
15 mai 2013 à 15:57
J'avais compris quelques parties du code entre temps, notamment en me renseignant sur les fonction redim et ubound, mais aussi en me renseignant sur les tutos variables tableaux (notamment sur le site que tu conseilles !). J'avais bien compris que l'on créé des sortes de tableau "virtuel" comme tu le dis, mais je n'avais pas compris le fonctionnement...

Une nouvelle fois (au risque de me répéter), je te remercie infiniment pour ton aide et le temps que tu as passé. Cette aide m'a grandement servi pour mon programme !
0
michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
13 mai 2013 à 18:36
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
0
michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
14 mai 2013 à 09:14
Bonjour,

En attendant que Mjgoat se réveille, un exemple de comparaison (communs, unique1, unique2) de 2 listes de 10000 lignes en 0,7 secondes (ram 512 Mo, proc 3Ghz)

https://www.cjoint.com/?3EojmYcFC0c
0
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 10
14 mai 2013 à 09:34
Bonjour,

Tout d'abord, merci de votre réponse michel_m !

En effet, j'ai fait une faute de frappe : ce sont bien des feuilles et non des fichiers.

Voici mon fichier Excel sur lequel je travaille.
https://www.cjoint.com/?0EojzY32XQ2
0
michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
14 mai 2013 à 11:47
Bonjour

j'ai commencé le code mais tu as au moins un doublon dans les clés de RTMP0001 ligne 3816 et 4301 clé: "MERCEDES-G0519DE-Solo Rigid-03500"
donc la comparaison totale est impossible car je sors de la macro

merci de regarder cette erreur et éventuellement d'autres
pour trouver, dans la colonne I tu écris =nb.si(I$2:I$10000;I2) qui t'indiquera les doublons

dans l'attente du classeur corrigé :o)
je serais certainement absent cet après-midi
0
michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
14 mai 2013 à 13:23
lire 4302 au lieu de 4301
et colonne J au lieu de I
une fois saisi la formule faire un double clic sur le carré noir en bas et à droite de la cellule J2
0
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 10
14 mai 2013 à 15:37
Je vous remercie michel, je vais tester ça !
0
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 10
16 mai 2013 à 15:39
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 !
0
michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
16 mai 2013 à 16:12
bonjour,

le problème est que je n'ai plus le classeur et cjoint me dit que lien n'est + disponible
0
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 10
16 mai 2013 à 16:37
Je viens de refaire un lien sur cijoint, en esperant qu'il fonctionne...

https://www.cjoint.com/?0EqqpJaYwgh
0
michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
16 mai 2013 à 16:57
Bon, je l'ai retrouvé dans la corbeille !

comme d'hab modifications en gras

 With Sheets("Copie table types mines")
          Derlig = .Columns("C").Find("*", , , , , xlPrevious).Row
          T_ct = .Range("C2:G" & 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, 1)) Then
                    Dico.Add T_ct(Lig, 1), T_ct(Lig, 5)

et
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) = Dico.Item(Cle)
               Else
                    T_out(Lig) = "Non Trouvé"
               End If
0
michel_m Messages postés 16589 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 12 janvier 2023 3 289
17 mai 2013 à 10:19
Bonjour,

On s'est embarqué dans une macro de derrière les fagots alors qu'avec une formule...

dans la feuille "copie":
j'ai nommé la colonne C "cle" et les colonnes C à G "cle_type"

feuille "rtm" en J2
=SI(I2="";"";SI(NB.SI(Cle;I2)=0;"non trouvé";RECHERCHEV(I2;cle_type;5;0)))
tu double-cliques sur le carré noir en bas et à droite de J2....
tu peux tirer ver le bas plus loin ,12000.par ex, car la formule commence par le cas ou Ix est vide

comme quoi...pourquoi faire simple quand etc etc
0
MJGOAT Messages postés 15 Date d'inscription jeudi 25 avril 2013 Statut Membre Dernière intervention 24 mai 2013 10
17 mai 2013 à 11:11
Merci pour tout michel !
0