Optimisation de code VBA

Version imprimable

Bonjour ! :D

Voici mon code :

Ce code parcours une feuille contenant des numéros d'articles sans doublons, puis il recherche le même article dans une feuille avec des doublons. Ensuite compare pour le même article la colonne des unités qui se trouve dans la colonne à côté de l'article concerné à ce moment. Puis si les unités correspondent il écrit OK sinon KO.
Code:

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 Sub Recherche() ' Dim str1, str2, str3, str4 As String For i = 11 To Feuil3.UsedRange.Rows.Count ' boucle de lecture de la feuille Creation For ii = 2 To Feuil4.UsedRange.Rows.Count ' boucle de lecture de la feuille MMS015 str1 = Feuil3.Cells(i, 3) str2 = Feuil4.Cells(ii, 2) str3 = Feuil3.Cells(i, 5) str4 = Feuil4.Cells(ii, 4) If str1 = str2 Then ' les 2 articles correspondent If str3 = str4 Then ' les 2 unités correspondent Feuil3.Cells(i, 1) = "OK" Else Feuil3.Cells(i, 1) = "KO" End If End If Next ii Next i End Sub
Je l'utilise pour un grand nombre de données et j'ai estimé le temps d'exécution à 2h30 ! J'ai par conséquent absolument besoin de l'optimiser !
Mais je ne suis pas un expert en la matière !!
Quelqu'un peu m'aider ?
:D

a++

Bonjour à tous
Bonjour JavierMartinez

Je n'ai pas testé, mais regardes le code ci-dessous :

Code:

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
Sub recherche()
Dim c, firstaddress
Dim i As Integer
Dim ligne As Integer    'juste pour vérifier
Dim str1, str3, str5 As String
 
 
For i = 11 To Feuil3.UsedRange.Rows.Count ' boucle de lecture de la feuille Creation
str1 = Cells(i, 3)
str3 = Cells(i, 4)
str5 = Cells(i, 1)
With Worksheets("Feuil4").Range("b:b")
 
    Set c = .Find(mavar, LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
            ligne = c.Row   'juste pour vérifier
            If Range("e" & c.Row) = str3 Then str5 = "OK" Else str5 = "KO"
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
End With
 
Next i
End Sub

si j'ai bien compris ce que tu cherches. C'est peut être plus rapide

Eric

SAlut
Il serait possible d'avoir un fichier demo avec la structure de tes feuilles s'il te plait?
[Edit]
En attendant voila comment je ferais a toi d'adapter si pas exactement ce que tu veux

Code:

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
 
Sub RechercheVite()
Dim CelTest As Range
Dim CelFinded As Range
Dim FirstAddress As String
 
For Each CelTest In Sheets("Feuil3").Range(Range("Feuil3!C11"), Sheets("Feuil3").Cells(Rows.Count, "C").End(xlUp))
    'ensuite je suis ok avec Eric Find sera plus rapide
    With Sheets("Feuil4").Range(Range("Feuil4!C2"), Sheets("Feuil4").Cells(Rows.Count, "C").End(xlUp))
        Set CelFinded = .Find(CelTest.Value2, LookIn:=xlValues, Lookat:=xlWhole)
 
        If Not CelFinded Is Nothing Then
            FirstAddress = CelFinded.Address
            Do
                If CelTest.Offset(0, 2).Value2 = CelFinded.Offset(0, 2).Value2 Then
                    CelTest.Offset(0, -2).Value = "Ok"
                Else
                    CelTest.Offset(0, -2).Value = "Ko"
                End If
            Loop While Not CelFinded Is Nothing And CelFinded.Address <> FirstAddress
        End If
    End With
Next
 
End Sub

J'ai pas eu le temps de tester le code ... je suis a la bourre pour reprendre le taff :s
@Eric: Attention le faite de faire

Code:

Str5 = cells(...)

Ne fait que mettre la valeur de la cellule dans Str5, Str5 ne represente pas cette cellule, donc par la suite

Code:

str5 = "ok"

ne modifie que la variable Str5, pas ta cellule. Si tu veux faire cela il fait faire

Code:

1
2
3
Dim Str5 as range 'vaut mieux mettre un nom plus en rapport biensur c'est juste pour l'explication
Set Str5 = Cells(....)
Str5 = "Ok"

La ça fonctionnerai;)
[/Edit]
A++
Qwaz

22/02/2008, 15h51
edelweisseric

Re

Tout à fait d'accord Qwaz, mais j'avais bien spécifié "pas testé"

Le mieux serait de mettre tout simplement

Code:

Cells(i,1)="OK"

quoiqu' il faudrait peut-être mettre :

Code:

sheets("Feuil3").Cells(i,1)

Je ne sais pas pourquoi je suis passé par la variable str5. Quant au niveau du nom de variable je suis beaucoup plus explicite, mais là j'ai repris le "style" de JavierMartinez

Eric

Merci beaucoup

:D
Merci pour votre aide, cependant j'ai fais moi même une petite optimisation et elle me convient à 100%...(j'ai seulement fais un petit test en plus)

voici le code (qui fonctionne, pour ceux que sa intéresse) :

Code:

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
41
Sub Recherche()
'
 
Dim str1, str2, str3, str4 As String
 
 
 
 For i = 11 To Feuil3.UsedRange.Rows.Count  ' boucle de lecture de la feuille Creation
    For ii = 2 To Feuil4.UsedRange.Rows.Count ' boucle de lecture de la feuille MMS015
        str1 = Feuil3.Cells(i, 3)
        str2 = Feuil4.Cells(ii, 2)
        str3 = Feuil3.Cells(i, 5)
        str4 = Feuil4.Cells(ii, 4)
 
        If str1 = str2 Then ' les 2 articles correspondent
 
           If str3 = str4 Then ' les 2 unités correspondent
                Feuil3.Cells(i, 1) = "OK"
 
                If Feuil4.Cells(ii + 1, 4) = Feuil4.Cells(ii, 4) Then
 
                Else
                    Exit For
                End If
 
           Else
                Feuil3.Cells(i, 1) = "KO"
 
                If Feuil4.Cells(ii + 1, 4) = Feuil4.Cells(ii, 4) Then
 
                Else
                    Exit For
                End If
           End If
 
        End If
 
    Next ii
 Next i
 
End Sub

Je répète ce qu'elle fait...

Elle parcours une colonne dans la Feuille1, puis recherche le même "article" dans le feuille2 (qui contient des doublons) puis elle compare pour chaque article si la colonne "unité de base" est la même : - si oui, elle mets OK dans la colonne a de la feuille1
- sinon elle mets KO dans la colonne A de la feuille1.

Bonne journée et encore merci !!!
;)

SAlut
Libre a toi.
Mais modifies peut être au moins ca

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
           If str3 = str4 Then ' les 2 unités correspondent
                Feuil3.Cells(i, 1) = "OK"
 
                If Feuil4.Cells(ii + 1, 4) = Feuil4.Cells(ii, 4) Then
 
                Else
                    Exit For
                End If
 
           Else
                Feuil3.Cells(i, 1) = "KO"
 
                If Feuil4.Cells(ii + 1, 4) = Feuil4.Cells(ii, 4) Then
 
                Else
                    Exit For
                End If
           End If

En ça

Code:

1
2
3
4
5
6
7
    If str3 = str4 Then ' les 2 unités correspondent
         Feuil3.Cells(i, 1) = "OK"
    Else
         Feuil3.Cells(i, 1) = "KO"
    End If
 
    If Feuil4.Cells(ii + 1, 4) <> Feuil4.Cells(ii, 4) Then Exit For

c'est quand même plus digeste non ? ;)
A++
Qwaz

Quitte à simplifier, autant employer IIf :

Code:

1
2
    Feuil3.Cells(i, 1) = IIf(str3 = str4, "OK", "KO")
    If Feuil4.Cells(ii + 1, 4) <> Feuil4.Cells(ii, 4) Then Exit For