Lignes contenant une chaîne donnée

Bonjour,

Sub cherche_plusieurs()
Range("A1:A20").Interior.ColorIndex = 36
mot = InputBox("mot cherché?")
If mot = "" Then Exit Sub
Range("A1:A20").Select
Set c = Selection.Find(mot, LookIn:=xlValues, LookAt:=xlPart) '
xlwhole
If Not c Is Nothing Then
premier = c.Address
Do
c.Interior.ColorIndex = 4
Set c = Selection.FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier
End If
End Sub

Cordialement JB

bonjour
veuillez tester ça
merci à daniel

Sub test()
Dim Ligne As Long
Ligne = Range("A65536").End(xlUp).Row
For i = Ligne To 1 Step -1
If Range("A" & i).Value = "toto" Then
'votre instruction ici End If
Next i
End Sub

bon courage

Les temps d'exécution avec FIND sont divisés pa 10 (test sur 10.000
éléments dans la colonne)

Sub test() ' 0,32 secondes
t = Timer
Dim Ligne As Long
Ligne = Range("A65536").End(xlUp).Row
For i = Ligne To 1 Step -1
If Range("A" & i).Value = "bbb" Then
Range("A" & i).Interior.ColorIndex = 4
End If
Next i
MsgBox Timer - t
End Sub

Sub essai_jb() ' 0,21 secondes
t = Timer
For Each c In Range([A1], [A65536].End(xlUp))
If c.Value = "bbb" Then
c.Interior.ColorIndex = 4
End If
Next c
MsgBox Timer - t
End Sub

Sub cherche_plusieurs() ' 0,031 secondes
Range("A1:A1000").Interior.ColorIndex = 36
mot = "bbb"
Range([A1], [A65536].End(xlUp)).Select
t = Timer
Set c = Selection.Find(mot, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
premier = c.Address
Do
c.Interior.ColorIndex = 4
Set c = Selection.FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier
End If
MsgBox Timer - t
End Sub

JB

OK merci à JB et à Kamal ...