Améliorer performance boucle vba

**mouncefdi** · 06/03/2009, 11h11

Je suis un débutant en VBA, et je suis nouvo sur le forum.
J'espere que quelquun pourrait m'aidé pour me simplifier la vie dans mon stage...voila mon probleme:

J'ai un fichier excel avec deux sheets, sur la sheet "Main Tresh" je récupere les données se trouvant sur la colonne 18 de la sheet "EMR".
Pour ce qui est de la structure des 2 sheets:
Dans la sheet Main tresh de la cell(1,4) jusqu'à la cell(1,97) j'ai un ensemble de clés, ces dernieres sont les memes que les clés que je pourrais avoir ac les noms des cells (k,6) à (k,17) sur la sheet "EMR".
Pour le tableau "Main Tresh" j'ai 356 lignes pour 97 colonnes.
pour la sheet "EMR" j'ai 24 colonnes é 3402 lignes. le nbre des lignes pouvant changé sur cette sheet jai mis en place une boucle ki s'arrete à la premiere ligne vide.
dans les cellules de ma sheet "Main Tresh" je récupère les données de la colonne 18 de la sheet "EMR".
Les cellules à remplir ds ma sheet " Main Tresh" se trouve à partir de la colonne 4 inclus.
Une fois la macro lancé ca prend une éternité, je souhaitrais savoir comment je pourrais améliorer la performance de ma boucle????

Je vous remercie d'avance...
a tte

**erfindel** · 06/03/2009, 11h48

Si j'ai compris :

Tu cherches la premiere ligne vide ?

Tu fait simplement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
'DECLARATION
Dim plage as range
dim cellule as range
'DEFINITION DE TA FEUILLE
With Worksheets(Nomdetafeuille)
set plage  =  .range(taplage)
'VERIFIE CHAQUE CELLULE
For each cellule in plage
'SI VIDE
 if cellule = "" then 
    'ON LA SELECTIONNE ET ON QUITTE LA BOUCLE
   .cells(cellule.row, cellule.column).select
   exit for
 END IF
next

**mouncefdi** · 06/03/2009, 12h12

Je ne cherche pas la premiere liogne vide je fais des boucles pour remplir un tableau en cherchant pour chaque clé la valeur correspondante ds une otr feuille.
je ne sai pa si C clair...mai je te remercie pr ta réponse mais je ne vois pas comment ca pourrait m'aider pr améliorer mon code...
Je suis vraimen débutant en vba....

**ouskel'n'or** · 06/03/2009, 12h25

Regarde ici, le code proposé parcourt les cellules d'une colonne dans une feuille de calculs et, pour chaque donnée, recherche l'équivalence dans une colonne d'une autre feuille.
Une fois la donnée trouvée la ligne est copiée sur une troisième feuille. Tu auras juste cette dernière action à modifier.
Si tout n'est pas clair, tu demandes

**Gorfael** · 06/03/2009, 13h27

Salut mouncefdi et le forum
Ne mélange pas français, code et langage SMS, ça ne simplifie pas la compréhension du problème ! Le but n’est pas que tu écrives vite, mais que la réponse soit rapide, non ? Et comme on ne connaît du problème que ce que tu écris…
Pas très clair, pour moi, ton laïus. Prends du temps pour exposer ton problème. Il vaut mieux passer 2 heures à exposer ton problème que passer des jours à expliquer que les réponses ne correspondent pas à la question !

Ce que je crois comprendre :
2 feuilles : "Main Tresh" et "EMR" et tu veux recopier des valeurs de la seconde sur la première

Question :
Si la concaténation de clés des colonnes 4(D) à 97 (CS) d’une ligne de "Main Tresh" correspondent à la concaténation des cellules des colonnes 6(F) à 17(Q) d’une ligne de "EMR" tu veux inscrire la cellule 18(R) de cette ligne dans la ligne en cours de "Main Tresh" à la colonne ???

Question :
Lorsqu’on a trouvé une égalité et qu’on recopie la cellule de la colonne 18(R), peut-on sortir de la boucle de "EMR" ou doit-on n’inscrire que la dernière occurrence ?

A+
PS oui, je sais, mais je n'aime pas travailler en L1C1, je trouve plus facile A1

**mouncefdi** · 06/03/2009, 16h08

comment je pourrais introduire dans mon code un find qui va prendre la valeur sur la colonne R de la feuille EMR et l'introduire dans l'autre feuille Main Tresh ?
je pense que ce serait le meilleur moyen pour améliorer mon code ( c'est ce qu'ont m'a dit en tout cas).....
merci

**Gorfael** · 06/03/2009, 18h18

Salut mouncefdi et le forum
D'après le fichier exemple, la macro donnerait quleque chose comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub test()
Dim F1 As Worksheet, F2 As Worksheet
Dim Lig As Long
Dim Col As Integer
Dim X As String, Y As String
Set F1 = Sheets("EMR")          'base de donnée
Set F2 = Sheets("Main Thresh") 'feuille résultat
For Col = 4 To F2.Cells(1, F1.Columns.Count).End(xlToLeft).Column
    For Lig = 4 To F1.Range("A" & F1.Rows.Count).End(xlUp).Row
        F2.Cells(2, Col).Clear
        If F2.[A2] = F1.Range("F" & Lig) Then
            If F1.Cells(Lig, "G") & F1.Cells(Lig, "H") & F1.Cells(Lig, "I") & F1.Cells(Lig, "J") & _
               F1.Cells(Lig, "K") & F1.Cells(Lig, "L") & F1.Cells(Lig, "M") & F1.Cells(Lig, "N") & _
               F1.Cells(Lig, "O") & F1.Cells(Lig, "P") & F1.Cells(Lig, "Q") = F2.Cells(1, Col) Then
                F2.Cells(2, Col) = F1.Range("R" & Lig)
                Exit For
            End If
        End If
    Next Lig
Next Col
End Sub

Une solution par Find donnerait pour chaque ligne de la base de donnée (3400 ligne) tu fais la concaténation et tu recherches dans les 93 colonnes. Je sais pas si ça serait plus rapide.
A+

**ouskel'n'or** · 08/03/2009, 10h56

Comme je n'avais rien de prévu j'ai regardé plus à fond ta procédure et, pour ce que j'en ai compris, tu peux "peut-être" tester ce code avec find. Il serait bien, si tu as un pb avec lui, que tu complètes/corriges les commentaires que j'ai placé.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Explicit
Sub test()
Dim i As Integer, j As Integer, k As Integer
Dim cle As String, CurrString As String
Dim FL1 As Worksheet 'Feuille "Main Thresh"
Dim FL2 As Worksheet 'Feuille "EMR"
Dim c As Range, LigDeb As String
   Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à venir)
     Set FL1 = Worksheets("Main Thresh")
     Set FL2 = Worksheets("EMR")
    CurrString = ""
    j = 4
    Application.ScreenUpdating = False
    While FL1.Cells(1, j).Value <> ""
        'Comment est fixé 360 ? (***)
        For i = 2 To 360
'La clé est constituée des colonnes 1, 2 et 3 d'une même ligne & de la colonne J de la ligne 1
            cle = FL1.Cells(i, 1).Value & FL1.Cells(i, 2).Value & FL1.Cells(i, 3).Value & FL1.Cells(1, j).Value
 
'Recherche de la valeur de FL1.Cells(i,1) dans la colonne F de FL2
            With FL2.Range("F2:F" & Split(FL2.UsedRange.Address, "$")(4))
                Set c = .Find(FL1.Cells(i, 1).Value)
                If Not c Is Nothing Then
                    LigDeb = c.Address
                    Do
                        k = c.Row
                        CurrString = FL2.Cells(k, 6).Value & FL2.Cells(k, 7).Value & FL2.Cells(k, 8).Value & FL2.Cells(k, 9).Value & FL2.Cells(k, 10).Value & FL2.Cells(k, 11).Value & FL2.Cells(k, 12).Value & FL2.Cells(k, 13).Value & FL2.Cells(k, 14).Value & FL2.Cells(k, 15).Value & FL2.Cells(k, 16).Value & FL2.Cells(k, 17).Value
                        If CurrString = cle Then FL1.Cells(i, j) = FL2.Cells(k, 18)
'Cette recherche ne se poursuit que si FL1.Cells(i, 1) a été trouvé
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> LigDeb
                End If
            End With
        Next i
'Ajoute une ligne à FL1
        j = j + 1
    Wend
   Application.ScreenUpdating = True
End Sub

Question subsidiaire : Ton code d'origine, bien que lent, réalise-t-il ce que tu veux ?
A+

Note - Je commence par une recherche de FL1.Cells(i,1) avant de vérifier la clé. Ainsi je n'examine pas toutes les lignes seulement celles dont au moins une valeur correspond

**mouncefdi** · 08/03/2009, 16h03

Merci Gorfael, ouskel'n'or, pour votre aide.
Pour ta question subsidiaire ouskel'n'or, effectivement mon code marche mais il prend trop de temps pour me remplir le tableau.
Pour vos deux codes, ils sont largement mieux en terme de rapidité, mais le problème est qu'ils ne me remplissent qu'une petite partie de mon tableau.
J'essaye de les généraliser, je ne sais pas si je vais réussir à le faire, puisque je suis un novice en informatique.
Si vous avez d'autres remarques par rapport aux codes je reste à votre écoute....
Merci beaucoup en tout cas pour l'aide....
A+

**ouskel'n'or** · 08/03/2009, 17h08

Alors choisis un code, celui de Gorfael ou le mien (mais je pense que, par construction, le mien a des chances d'être plus rapide

) et dis-nous lequel tu prends et ce qu'il ne fait pas

Ce qui serait également bien pour toi serait de nous dire si tu ne comprends pas certaines parties du code.
A+

**mouncefdi** · 08/03/2009, 22h30

merci ouskel'n'or je vous tiendrais au courant, je suis en train de travailler la dessus maintenant d ailleurs...
Des questions la dessus sont à venir.....

Merci encore pour l'aide précieuse

**jolop35** · 08/03/2009, 22h57

Bonsoir à tous

Une question aux spécialistes
En transférant les valeurs des cellules dans des Arrays

le code ne serait-il pas plus rapide ?

Bonne fin de soirée.

**ouskel'n'or** · 09/03/2009, 00h16

Envoyé par jolop

En transférant les valeurs des cellules dans des Arrays
le code ne serait-il pas plus rapide ?

Avant de voir le fichier c'était mon idée. Maintenant, je ne sais pas si on gagnerait beaucoup, la reconstitution de la clé complique l'utilisation d'un tableau puisque la concaténation ne concerne ni les mêmes lignes ni les mêmes colonnes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

cle = FL1.Cells(i, 1).Value & FL1.Cells(i, 2).Value & FL1.Cells(i, 3).Value & FL1.Cells(1, j).Value

Mais si tu vois une solution pérenne...
Bonne soirée

**mouncefdi** · 09/03/2009, 11h27

Ton code est très efficace ouskel'n'or
Il me permet de récupérer mes valeurs en un temps record..
Merci pour ton aide précieuse....

une tte petite question ouskel'n'or, dans la partie du code ou tu utilise find est ce que je peux faire un find pour chercher un nom qui correspond à une concaténation de deux cellules sur la sheet FL2.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
'Recherche de la valeur de FL1.Cells(i,3) dans la colonne F de FL2
            With FL2.Range("F2:F" & Split(FL2.UsedRange.Address, "$")(4))
                Set c = .Find(FL1.Cells(i, 3).Value)

je veux chercher la cell(i,3) dans la concaténation de E&F, est ce que c'est possible...?

**ouskel'n'or** · 09/03/2009, 19h08

Oui, si tu utilises xlpart dans le paramètre lookat. Signifie que tu chercheras une partie du mot contenu dans la cellule et non la cellule "entière"
xlpart pour un bout du mot
xlwhole pour tout le mot
Mais regarde à "Find, Méthode" appliqué à un range, dans l'aide en ligne (F1)

Ensuite, tu peux utiliser Instr afin de connaître la position du mot dans la cellule en cas de besoin
Par exemple, si instr(ContenueDeLaCellule, MotCherché) = 1 signifie que ContenueDeLaCellule commence par ce mot.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ContenuDeLaCellule = "Coucou c'est moi !"
MotCherché = "Coucou"
PositionDeCoucouDansLaCellule = Instr(ContenuDeLaCellule, MotCherché) '= 1

Bref, regarde dans l'aide en ligne, ce sera plus simple

Bonne soirée

**mouncefdi** · 09/03/2009, 22h15

merci le pbm est résolu...

Améliorer performance boucle vba

Macros et VBA Excel

Discussions similaires

Partager

Partager