Optimisation Boucle de recherche

[Sniker]

En novembre dernier j’ai fait appel 3 ou 4 fois à votre expertise pour me faire avancer sur quelques fonctions et je vous renouvelle mes remerciements.

Pour rappel voici mon projet de départ :
Lien supprimé

Depuis j’avance doucement, je bricole, jonglant avec mes vielles connaissances en Visual basic et l’aide disponible sur excel.

J’arrive enfin à un résultat, la macro fonctionne, je voudrais y ajouter encore quelques options, mais avant ça j’aimerais optimiser la boucle principale. En effet le temps de traitement pour croiser deux fichiers de plus de 5000 lignes prend plus de 10 minutes sur un ordi moyen.

Voila le noyau de recherche pour l’option la plus simple :

WB1 et WB2 sont les noms des deux classeurs à comparer
SH1 et SH2 sont les noms des deux feuilles
Lc1 et Lc2 nombre de lignes total de chaque tableau
Ct1 et Ct2 nombre de colonnes total de chaque tableau
Nc1 et Nc2 Numéro de colonne des deux tableaux à comparer
Lt1 et Lt2 Numéro de ligne contenant les titres de colonne
LtB() Correspond aux numéros de colonnes à transférer du 2em tableau au 1er

'  Integration des lignes dans le tableau A pour l option1 '
'----------------------------------------------------------'

If Option1.Value = True And Option2criteres.Value = False Then

' Recopie les titres du 2em tableau dans le premier'
For i = 0 To j - 1                          
   celval = Workbooks(WB2).Worksheets(SH2).Cells(Lt2, LtB(i) + 1).Value
   Workbooks(WB1).Worksheets(SH1).Cells(Lt1, Ct1 + i + 1).Value = celval
Next i

For Vs1 = Lt1 + 1 To Lc1                    
  valeur = Workbooks(WB1).Worksheets(SH1).Cells(Vs1, Nc1).Value
  For Vs2 = Lt2 + 1 To Lc2
  If valeur = Workbooks(WB2).Worksheets(SH2).Cells(Vs2, Nc2).Value Then
    For i = 0 To j - 1
      celval = Workbooks(WB2).Worksheets(SH2).Cells(Vs2, LtB(i) + 1).Value
      Workbooks(WB1).Worksheets(SH1).Cells(Vs1, Ct1 + i + 1).Value = celval
    Next i
  Vs2 = Lc2 
  End If
  Next Vs2
Next Vs1
End If

J’ai ajouté « Vs2 = Lc2 » en fin de boucle Vs1 pour raccourcir le temps de recherche lorsque une valeur est trouvée, mais dans une autre option j’intègre autant de ligne que de résultats correspondants. Ce qui rend la recherche très longue.

Est-ce que si je copie les valeurs des deux colonnes à comparer dans des variables avant de comparer cela fait gagner du temps ?

Peut ont raccourcir le traitement en faisant un tri des deux colonnes avant ?

Vais-je gagner en rapidité, si au lieu de copier les valeurs dans le tableau à l’intérieur de la boucle, je mets en variable les numéros de lignes, pour compléter le tableau à la fin ?

Comment puis-je intégrer un genre de chronomètre dans ma boucle pour faire des tests et connaître le solution la plus rapide ?

Même si tout ne vous semble pas clair, pouvez vous m’aiguiller ?

Si vous avez besoin de voir ma macro entière pour comprendre je veux bien vous l’envoyer en privé mais je dois avouer que c’est un gros « torchon » de débutant.

Merci aux courageux

A bientôt certainement.

Message édité par: sniker, à: 06/03/2006 13:06

 

[jp14]

Bonjour

Dans un premier temps voir ce fil pour trouver les idées de base

Lien supprimé

Dans la deuxième boucle que se passe-t-il si 'valeur' est vide ('')?
Si on ne fait rien on peut utiliser une fonction de la forme
If valeur ='' then exit next.

Quel est le classeur et la feuille active pendant l'éxécution de la macro, ce qui permet de supprimer du code de ce type
Workbooks(WB2).Worksheets(SH2)

A+

Message édité par: jp14, à: 06/03/2006 14:19

Message édité par: jp14, à: 06/03/2006 14:22

 

[Charly2]

Bonjour Sniker, bonjour jp14, bonjour à toutes et à tous

C'est un exercice assez délicat lorsqu'on a pas le fichier, mais essaie ce code qui, s'il fonctionne, devrait légèrement accélérer ton transfert de données :

Option Explicit
' ...
' ...
Dim FoundCell As Range
Dim Tab2 As Variant

If Option1.Value = True And Option2criteres.Value = False Then
  ' Recopie les titres du 2em tableau dans le premier'
  With Workbook(WB2).Worksheet(SH2)
    For i = 0 To j - 1
      Workbooks(WB1).Worksheets(SH1).Cells(Lt1, Ct1 + i + 1) = .Cells(Lt2, LtB(i) + 1)
    Next i
    
    For Vs1 = Lt1 + 1 To Lc1
      Valeur = Workbooks(WB1).Worksheets(SH1).Cells(Vs1, Nc1)
      Set FoundCell = .Range(.Cells(Lt2 + 1, Nc2), .Cells(Lc2, Nc2)).Find(what:=Valeur, LookIn:=xlValues, lookat:=xlWhole)
      If Not FoundCell Is Nothing Then
        Tab2 = .Range(.Cells(FoundCell.Row, LtB(0) + 1), .Cells(FoundCell.Row, LtB(j - 1) + 1))
        Workbooks(WB1).Worksheets(SH1).Cells(Vs1, Ct1 + 1).Resize(1, j) = Tab2
        Erase Tab2
      End If
    Next Vs1
  End With ' Workbook(WB2).WorkSheet(SH2)
End If

Tiens-nous au courant

A+

 

[Charly2]

re,

Je suppose que tu as déjà mis dans ta procédure :

Sub MaProc()
Application.ScreenUpdating = False
' Ton code
Application.ScreenUpdating = True
End Sub

Petit complément : si tu as des fonctions dans tes classeurs, tu peux désactiver le calcul automatique :

Dim OldCalculation&

With Application
OldCalculation = .Calculation
.Calculation = xlCalculationManual
End With

' Ton code

Application.Calculation = OldCaculation

Sinon, tu peux vérifier la rapidité d'exécution d'un code (entier ou en partie) en écrivant par exemple :

Dim TDebut!, TFin!

TDebut = Timer

' Ton code

TFin = Timer

MsgBox 'Temps d'exécution : ' & (TFin - TDebut)

Voilà

A+

 

[Sniker]

Bonsoir Jp14, Charly2 et le forum.

Je vous remercie beaucoup tout les deux pour les conseils.

Jp14, j'ai consulté le fils que tu me propose, et vérifié la déclaration des variables.
Ma variable 'valeur' ne devrait jamais être vide donc ce n'est pas très utile de sortir de la boucle dans cette condition.

Charly2, je suis épaté par ta maîtrise du VBA, je vais essayer de remplacer mon code par les tiens ce soir et en apprécier le gain.
Si tu me le permet je risque de te solliciter à nouveau pour être sur de bien comprendre la mécanique de ce que tu as modifié.
Par la suite je vais devoir adapter celle ci aux options que j'ai en tête.

Merci encore à tout les deux.

 

[Sniker]

Bonsoir Jp14, Charly2 et le forum.

Je vous remercie beaucoup tout les deux pour les conseils.

Jp14, j'ai consulté le fils que tu me propose, et vérifié la déclaration des variables.
Ma variable 'valeur' ne devrait jamais être vide donc ce n'est pas très utile de sortir de la boucle dans cette condition.

Charly2, je suis épaté par ta maîtrise du VBA, je vais essayer de remplacer mon code par les tiens ce soir et en apprécier le gain.
Si tu me le permet je risque de te solliciter à nouveau pour être sur de bien comprendre la mécanique de ce que tu as modifié.
Par la suite je vais devoir adapter celle ci aux options que j'ai en tête.

Merci encore à tout les deux.

 

[Charly2]

re

Pas de souci, si tu as besoin tu reviens sur ce fil ou tu m'envoies un mot sur la messagerie d'XLD.

Pour le code que je t'ai proposé, je pense qu'il devrait fonctionner à condition d'ajouter 2 S :

With Workbooks(WB2).Worksheets(SH2)

Si les colonnes à copier ne sont pas adjacentes :

ReDim Tab2(1, 1 To j)
For i = 0 To j - 1
  Tab2(1, i + 1) = .Cells(FoundCell.Row, LtB(i) + 1)
Next i
Workbooks(WB1).Worksheets(SH1).Cells(Vs1, Ct1 + 1).Resize(1, j) = Tab2
Erase Tab2

A+

Message édité par: Charly2, à: 06/03/2006 21:04

 

[Sniker]

Ok

J'ai réussi du premier coup à faire fonctionner ta première proposition, je l'ai étudiée pas à pas et j'ai compris, je pense, le coté pratique de 'Find'.

Puis je me suis aperçu que je ne pouvais plus choisir les colonnes à récupérer. Et comme par miracle tu as répondus avant même que j'essaye de réintégrer ma petite boucle 'for i ...'

Sauf qu'il y a un truc qui bloque et Je n'arrive pas à comprendre à quoi sert le 'ReDim Tab2' du coup je me demande si je l'ai bien positionné
Je ne vois pas non plus à quoi sert '.resize()'.

Pour te faciliter la tache je te joints mon « torchon », j’ai effacé les quelques options que j’avais mise en chantier donc certains chois donnent dans le vide.

Merci encore pour tous tes efforts [file name=TestMacro11.zip size=29002]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/TestMacro11.zip[/file]

 

[Charly2]

re Sniker,

D'abord, ce que tu dis être ton torchon, je suppose que certains aimeraient bien pouvoir le développer eux-même de la sorte

Pour ce que j'ai vu, tu as correctement positionné le Redim Tab2 qui est un tableau dynamique au même titre que LtB() dans ton code. Comme je n'ai pas donné les dimensions au départ, je le fais dans le code, puis une fois le traitement fait dans une boucle, je libère la mémoire et je pars sur un ReDim, ce qui a pour effet de vider le tableau précédent et réinitialiser ses éléments à empty.

Quant au Resize, on peut faire (Plage étant un objet Range) :

Plage = Tableau,

mais il faut alors que le nb de lignes et de colonnes de Plage corespondent exactement à ceux de Tableau.

Dans le cas présent, Tab2 a 1 ligne et j colonnes (rectifier le ReDim avec 1 To 1 pour les lignes), il faut donc que l'objet Range Plage ait les même dimensions que Tab2, ce qui est assuré par :

Plage.ReSize(nbLignes, NbColonnes)

Ne pas confondre Resize et Offset :

Range('A1').Offset(0,1) correspond à Range('B1')

alors que

Range('A1').Resize(1,1) correspond à Range('A1'),
Range('A1').Resize(2,1) correspond à Range('A1:A2'),
Range('A1').Resize(1,2) correspond à Range('A1:B1')

Voili voilà

A+

 

[Sniker]

Je me répète mais merci encore une fois !

Je ne comprenais pas très bien le fonctionnement du dimensionnement des variables tableau, mais la c'est clair ...

Je ne connaissais pas non plus cette façon de définir une plage de cellule avec resize, comment ai-je pu utiliser Excel tant d'années sans connaitre ça !!!

Cela fonctionne très bien, et je vais récupérer au boulot mes énormes fichiers de plusieurs milliers de lignes pour comparer le temps de traitement ...

Je vais ensuite reprendre ma réflexion sur le cas ou plusieurs valeurs du tableau source correspondent au tableau cible et comment récupérer toutes les lignes ... :huh:

à bientôt

Message édité par: sniker, à: 08/03/2006 00:17