Re : Boucle du type For Each qui recherche une valeur partiel....
Bonjour
Public Sub atrouver() 'RECHERCHE DE VALEURS IDENTIQUES, SANS ERREUR SI LA RECHERCHE EST INFRUCTUEUSE
Feuil1.Activate 'ACTIVATION DE LA FEUILLE
Dim objCell As Range, PlageResult As Range, PremAdresse As String, atrouver As String
Dim Firstrow As Long, Firstcol As Long, Lastrow As Long, Lastcol As Long, Plage As Range
atrouver = "AXIOM" 'VALEUR À TROUVER
Firstrow = Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByRows).Row
Firstcol = Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByColumns).Column
Lastrow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Lastcol = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Set Plage = Range(Cells(Firstrow, Firstcol), Cells(Lastrow, Lastcol))
Plage.Select 'ICI SELECTION OBLIGATOIRE SINON ERREUR'
With Plage
Set objCell = .Find(What:=atrouver, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not objCell Is Nothing Then
PremAdresse = objCell.Address
Do 'CREATION DE LA COLLECTION DES VALEURS CHERCHÉES
If PlageResult Is Nothing Then
Set PlageResult = objCell
Else
Set PlageResult = Application.Union(objCell, PlageResult) 'ici se crée la collection des valeurs cherchées
End If
Set objCell = .FindNext(objCell)
Loop While Not objCell Is Nothing And objCell.Address <> PremAdresse
End If
If Not PlageResult Is Nothing Then
PlageResult.Interior.ColorIndex = 7 ' MARQUE LES VALEURS A TROUVER
'MsgBox (PremAdresse)
With Range(PremAdresse) ' MARQUE LES VALEURS A TROUVER
.Interior.ColorIndex = 6
End With
End If
End With
End Sub
Cordialement
Flyonets