J'ai réessayé et je n'ai pas ce problème chez moi.Ré-essaie en référence A1 sur une plage simple
Chez moi il décale systématiquement la plage par rapport à l'ActiveCell.
Si je lui dis A1:A2 et que ActiveCell est J1, il va en fait stocker J1:J2.
Set rngCellulesVerrouillees = ws.Cells.SpecialCells(xlCellTypeLocked)
Sub testDictionnary()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
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 dict.Exists(CStr(rngFound.Address)) Then
Exit Do
Else
dict.Add key:=CStr(rngFound.Address), Item:=rngFound.Address
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
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
En effet.il me semble que ça éclaire et donne la solution à ton pb sur le . Delete évoqué ensuite
Option Explicit
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Sub testDictionnary()
Dim StartTime As Double
Dim EndTime As Double
Dim ElapsedTime As Double
' Début du comptage du temps
StartTime = GetTickCount / 1000 ' Convertir les millisecondes en secondes
' **********************************
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
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 dict.Exists(CStr(rngFound.Address)) Then
Exit Do
Else
dict.Add key:=CStr(rngFound.Address), Item:=rngFound.Address
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
On Error Resume Next
rgn.Select
If Err.Number <> 0 Then Err.Clear
' *******************************
' Fin du comptage du temps
EndTime = GetTickCount / 1000 ' Convertir les millisecondes en secondes
' Calcul du temps écoulé
ElapsedTime = EndTime - StartTime
' Affichage du temps écoulé
MsgBox "Temps écoulé : " & ElapsedTime & " secondes", vbInformation
End Sub
Tu coches "Verrouillée" dans les options, mais le résultat est... surpenant : ça ne trouve les cellules verrouillées que dans la plage allant de la première à la dernière cellules non vides.Comment fais-tu avec Ctrl + F pour trouver la(es) plage(s) de cellules verrouillées ?
Au départ :Comment fais-tu avec Ctrl + F pour trouver la(es) plage(s) de cellules verrouillées ?
' 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 dict.Exists(CStr(rngFound.Address)) Then
Exit Do
Else
dict.Add key:=CStr(rngFound.Address), Item:=rngFound.Address
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
' Selection
On Error Resume Next
rgn.Select
MsgBox rgn.Address
If Err.Number <> 0 Then Err.Clear