Recherche valeurs identiques

[cyrus55160]

Bonjour,

Je réalise une comparaison de valeurs de cellules entre deux feuilles, et si les valeurs sont identiques je colorie la cellule.Le code que j'utilise est le suivant:

Sub essai()

Application.ScreenUpdating = False

nbreligne1 = Sheets("Feuil2").Range("A13").CurrentRegion.Rows.Count
nbreligne2 = Sheets("Feuil1").Range("A3").CurrentRegion.Rows.Count

For j = 3 To 3 + nbreligne2
For i = 13 To 13 + nbreligne1
var1 = Sheets("Feuil2").Cells(i, 2).Value
var2 = Sheets("Feuil1").Cells(j, 1).Value
If var1 = var2 Then
Sheets("Feuil1").Cells(j, 1).Interior.ColorIndex = 8
End If
Next i
Next j

End Sub


Par contre, je trouve que l'éxécution est longue (il y a 30000 lignes sur une feuille et 3000 sur l'autre) et cela dure 45 minutes environ.
Est ce normal ou est il possible d'avoir un code plus rapide.
PC utilisé : pentium dual core avec 1 Go de ram

Merci

 

[Spitnolan08]

Re : Recherche valeurs identiques

Re,

A priori, il suffit de remplacer cette ligne pour que ça fonctionne correctement

Set c = .Find(Sheets("feuil2").Cells(i, 1), lookat:=xlWhole)

et je reste sur mes 6 secondes

Cordialement

 

[cyrus55160]

Re : Recherche valeurs identiques

Bonjour,

C'est parfait, je vous remercie tous les deux, pour le code ainsi que les explications.
J'arrive dans les 10 secondes.

Passez une bonne journée, la mienne le sera grace à vous deux.

Merci beaucoup

 

[Spitnolan08]

Re : Recherche valeurs identiques

Re,

Comme Cyrus55160 ne nous donne pas le résultat des courses, j'ai pris 10' pour tester les 2 codes proposés sur ma base de données (30000 lignes sur la feuille1 et 3000 sur la feuille 2) de conception équivalente à la sienne.
Résultat :
Méthode Renauder : 8 minutes
Méthode bibi : 6 secondes (Ca n'a pas changé...😉)
pour un résultat identique.

Yapafoto... mais je n'aurais vraiment pas pensé trouver un écart aussi important.
Cordialement