Sortie de boucle

S

sonskriverez

Guest
Bonjour le forum

J'utilise le code suivant pour marqué en bleu la même cellule trouvée dans 2 feuilles différentes.

Le pbl est que j'ai une sortie de boucle 'Exit For' dés que la condition est atteinte. Je voudrais pouvoir continuer le test de 'cellule1' jusqu'a la fin de le feuille 'Sheet1' car il est possible que cellule1 = plusieurs cellule2

Sub Trouve()
Application.ScreenUpdating = False

Dim Cellule1, Cellule2, fin As Range


For Each Cellule1 In Worksheets('sheet1').Range('K2:K' &_ Range('K65536').End(xlUp).Row)
For Each Cellule2 In Worksheets('sheet2').Range('B25:B' &_ Range('B65536').End(xlUp).Row)
If Cellule1 = Cellule2 Then
Worksheets('sheet1').Activate ' active la feuille B
Cellule1.Font.Color = vbBlue ' si trouvé bleu
Worksheets('sheet2').Activate
Cellule2.Font.Color = vbBlue
Exit For
End If
Next Cellule2
Worksheets('sheet1').Activate
Next Cellule1
end sub

Merci de votre aide
 

Hellboy

XLDnaute Accro
Bonjour

Un début pour augmenter la rapidité, c'est d'éliminer les activate et de ne pas raffraichir l'écrant.


Dim sht1    As Worksheet, sht2    As Worksheet

Set sht1 = Worksheets('sheet1')
Set sht2 = Worksheets('sheet2')

Application.ScreenUpdating =
False

For Each Cellule1 In sht1.Range('K2:K' & sht1.Range('K65536').End(xlUp).Row)
For Each Cellule2 In sht2.Range('B25:B' & sht2.Range('B65536').End(xlUp).Row)
If Cellule1.Value = Cellule2.Value Then
    Cellule1.Font.Color = vbBlue
' si trouvé bleu
    Cellule2.Font.Color = vbBlue
End If
Next Cellule2
Next Cellule1
Set sht1 = Nothing
Set sht2 = Nothing

Application.ScreenUpdating =
True


Ensuite, pour 'augmenter' encore la vitesse un peu, serait d'employer le filtre automatique ou encore la commande search et search next.

Bon courage !
 

Discussions similaires

Réponses
2
Affichages
176

Statistiques des forums

Discussions
312 493
Messages
2 088 956
Membres
103 990
dernier inscrit
lamiadebz