Sub testCollection()
Dim col As New Collection
Dim rngFound As Range
Dim rgn As Range
Application.ScreenUpdating = False
Application.FindFormat.Locked = True
Application.FindFormat.FormulaHidden = False
' Boucle tant que pour rechercher toutes les cellules correspondantes
Do
' Recherche les cellules répondant aux conditions spécifiées
Set rngFound = Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
' Si une cellule correspondante est trouvée, l'activer
If Not rngFound Is Nothing Then
' Ajoute la première cellule trouvée à la collection
rngFound.Activate
If Exists(col, CStr(rngFound.Address)) Then
Exit Do
Else
col.Add key:=CStr(rngFound.Address), Item:=rngFound
If rgn Is Nothing Then
Set rgn = rngFound
Else
Set rgn = Union(rgn, rngFound)
End If
End If
End If
Loop While Not rngFound Is Nothing
'
Application.ScreenUpdating = True
' Selection
rgn.Select
End Sub
Function Exists(ByRef col As Collection, ByVal key As String) As Boolean
' Le code suivant vérifie si une clé existe
On Error GoTo EH
IsObject (col.Item(key))
Exists = True
EH:
End Function