XL 2021 VBA Alternative à SpecialCells(xlCellTypeVisible)

[Dudu2]

Bonjour

SpecialCells ne fonctionne pas sur une feuille protégée (erreur 1004).
J'ai besoin de connaître le Range des cellules visibles d'une feuille protégée.
Auriez-vous une fonction performante qui fait ça ?

Sub a()
    Dim R As Range
 
    On Error Resume Next
    Set R = ActiveSheet.Cells.SpecialCells(xlCellTypeVisible)
    MsgBox "Err.Number = " & Err.Number & IIf(Err.Number = 0, ", Range = " & R.Address(0, 0), "")
End Sub

 

[patricktoulon]

je pense que c'est toi qui n'a pas compris mon intervention @Dudu2
ce que j'ai voulu demontrer
1 il n'est pas necessaire de faire une copie pour compter les visible
2 et que le usedranrage est accessible même protégé
3 que je n'utilise pas le usedrange mais un range(.usedrange.address) qui est indirecte et me permet même si la feuille est protégée
de boucler sur les lignes et colonnes sans problème
parti de la toute vos solutions sont pas optimisées puisqu'il y a transfert et donc perte de temps
et je l'exprime clairement pourtant dans la video

 

[Dudu2]

Ok, je n'ai pas dû comprendre et on a sûrement tout faux (toute vos solutions sont pas optimisées puisqu'il y a transfert et donc perte de temps)

Dans le code de @mapomme on peut aisément passer un Range quelconque (dont le UsedRange) comme dans SpecialCells.

Function RangeVisibleCells(InputRange As Range) As Range
Dim Wkb As Workbook, Wks As Worksheet, Area As Range, WksInputRange As Range, Res As Range
    Application.ScreenUpdating = False                ' blocage affichage
    Set Wkb = Workbooks.Add: Set Wks = Wkb.Sheets(1)  ' nouveau classeur
    On Error GoTo Menage
    InputRange.Parent.Rows.Copy: Wks.Rows.PasteSpecial xlPasteFormats         ' copie des lignes de la feuille vers le nouveau classeur
    Application.CutCopyMode = False
    For Each Area In Wks.Cells.SpecialCells(xlCellTypeVisible).Areas   ' pour chaque plage visible de la nouvelle feuille
        If Res Is Nothing Then Set Res = InputRange.Parent.Range(Area.Address) _
                          Else Set Res = Union(Res, InputRange.Parent.Range(Area.Address))
   Next Area
Menage:
   If Not Res Is Nothing Then Set RangeVisibleCells = Intersect(InputRange, Res)      ' on affecte les plages visibles à la fonction
   Wkb.Close savechanges:=False     ' on supprime le classeur auxiliaire
End Function

 

[mapomme]

Re 😉

que je n'utilise pas le usedrange mais un range(.usedrange.address) qui est indirecte et me permet même si la feuille est protégée
de boucler sur les lignes et colonnes sans problème

Mais on a pas cure du UsedRange ou de son Adresse. Le UsedRange n'intervient pas dans la question !
Ce qu'on veut comme résultat c'est le range des plages visibles de la feuille quand cette feuille est protégée.
J'ai l'impression qu'on tourne tous autour du pot (moi compris) mais pas du même pot. L'avantage c'est qu'on peut tourner sans jamais se marcher dessus😉😀.

 

[Dudu2]

C'est pas grave @mapomme, on sait de quoi il retourne depuis le début.

Je me demande comment t'as fait pour trouver ce truc:

    InputRange.Parent.Rows.Copy
    Wks.Rows.PasteSpecial xlPasteFormats

C'et l'instruction qui tue pour conserver les lignes et colonnes masquées. J'ai essayé avec un Range au lieu de la feuille complète et je n'y suis pas arrivé, d'où l'Intersect final.

 

[Dudu2]

Bonjour les chercheurs de l'invisible,

Un truc aussi dont il faut se méfier, c'est le déclenchement d'un évènement SelectionChange() quand on fait appel à SpecialCells.
Voir -> https://www.excel-downloads.com/thr...evenement-Worksheet_SelectionChange.20062934/

Donc, sur la base du code de @mapomme, j'ai ré-écrit une fonction qui rend les cellules visibles du Range demandé que la feuille soit protégée ou non. A utiliser pour complètement remplacer SpecialCells(xlCellTypeVisible).

'--------------------------------------------------------------------------------------
'GetVisibleRange(Range)
'Remplace Range.SpecialCells(xlCellTypeVisible) notamment quand la feuille est protégée
'Basé sur le code de @mapomme https://excel-downloads.com/threads/vba-alternative-a-specialcells-xlcelltypevisible.20088688/post-20705943
'--------------------------------------------------------------------------------------
Function GetVisibleRange(InputRange As Range) As Range
    Dim Wkb As Workbook
    Dim Wks As Worksheet
    Dim Area As Range
    Dim Rng As Range
    Dim ErrNumber As Long
    Dim ScreenUpdatingAtCallTime As Boolean
    Dim EnableEventsAtCallTime As Boolean
         
    'Save ScreenUpdating & EnableEvents
    ScreenUpdatingAtCallTime = Application.ScreenUpdating
    EnableEventsAtCallTime = Application.EnableEvents
 
    'Pour éviter la génération spontanée d'un évènement SelectionChange() en référence à SpecialCells(xlCellTypeVisible)
    'Voir https://www.excel-downloads.com/threads/vba-generation-spontanee-de-levenement-Worksheet_SelectionChange.20062934/
    Application.EnableEvents = False
 
    On Error Resume Next
    'Visible Range
    Set Rng = InputRange.SpecialCells(xlCellTypeVisible)
    ErrNumber = Err.Number
    On Error GoTo 0
 
    'SpecialCells OK
    If ErrNumber = 0 Then
        Set GetVisibleRange = Rng
        GoTo ExitSub
    Else
        'SpecialCells sur feuille protégée -> Erreur 1004
        If ErrNumber = 1004 Then
            'OK à suivre
        Else
            'Pas de cellules de type xlCellTypeVisible
            GoTo ExitSub
        End If
    End If
 
    'Inhibe l'affichage
    Application.ScreenUpdating = False
 
    'Classeur & feuille temporaire
    Set Wkb = Workbooks.Add
    Set Wks = Wkb.Sheets(1)
 
    On Error GoTo ErrorHandler
 
    'Copie de la feuille d'origine protégée en Classeur temporaire
    InputRange.Parent.Rows.Copy
    Wks.Rows.PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
 
    'Reconstitution des Ranges visibles de toute la feuille d'origine protégée
    For Each Area In Wks.Cells.SpecialCells(xlCellTypeVisible).Areas
        If Rng Is Nothing Then Set Rng = InputRange.Parent.Range(Area.Address) _
                          Else Set Rng = Union(Rng, InputRange.Parent.Range(Area.Address))
    Next Area
 
ErrorHandler:
    On Error GoTo 0
 
    'Fermeture du Classeur temporaire
    Wkb.Close savechanges:=False
 
    'Limitation au Range en argument
    If Not Rng Is Nothing Then Set GetVisibleRange = Intersect(InputRange, Rng)
 
ExitSub:
    'Restore ScreenUpdating & EnableEvents
    Application.ScreenUpdating = ScreenUpdatingAtCallTime
    Application.EnableEvents = EnableEventsAtCallTime
End Function

 

[Dudu2]

Et pour ceux qui tiennent absolument à ne pas utiliser un classeur temporaire à condition que le UsedRange de la feuille ne fasse pas plus de 50.000 lignes sinon c'est la salle d'attente du dentiste...

 

[bsalv]

Un truc aussi dont il faut se méfier, c'est le déclenchement d'un évènement SelectionChange() quand on fait appel à SpecialCells.

allez, j'avais dit cela tout au début, poste #3 🙈

 

[mapomme]

sinon c'est la salle d'attente du dentiste...

ça sent le vécu. Me concernant, chez mon dentiste il n'y a aucune attente, mais alors chez le médecin!!!😉
Bon samedi @Dudu2 😉

allez, j'avais dit cela tout au début, poste #3 🙈

Comme quoi, nous ne lisons souvent que superficiellement.
Il faut nous causer avec l'option "Option ExplicitWriting" sinon nous pas comprendre les subtilités 😜🤪.
Bonne journée @bsalv 😉.

 

[Bernard_XLD]

Bonjour le fil, le forum

@Dudu2 , Union a une limite à 30 arguments ranges ce qui pourrait éventuellement poser problème.
https://learn.microsoft.com/fr-fr/office/vba/api/excel.application.union

Après, je n'ai pas testé si l'union d'une union de 30 ranges et d'une range supplémentaire passe ou si c'est uniquement une limite d'arguments de la fonction.

Cordialement,
Bernard_XLD

 

[Dudu2]

@bsalv, @mapomme,
Oui, vous avez mis un EnableEvents = False, mais je l'ai vu comme un précaution générale puisque non spécifiquement commenté comme étant relatif au SpecialCells. En plus c'était dans une fonction qui déprotégeait la feuille, donc j'ai lu en diagonale.
Mais ok, c'était présent.

 

[Dudu2]

Bonjour @Bernard_XLD,
Oui 30 arguments maximum. Mais pas évident à coder selon le nombre d'Areas.
Mais à mon avis qu'on mette 30 fois 1 Range ou 1 fois 30 Ranges ou 1 fois les 30 Ranges (si <= 257) le temps elpase est assez proche.

 

[Dudu2]

Il y a un truc qui n'a pas été exploité dans la méthode @mapomme.
C'est d'utiliser le classeur "appelant", celui qui exécute le code qui peut être le classeur contenant la feuille à analyser ou une autre classeur ou complément comme hébergeur de la feuille temporaire si ce classeur ou complément en permet la création, c'est à dire non protégé en structure.

Et là on passe de 0.25 seconde d'elapse moyen à 0.06 seconde, un sacré gain de temps (4 à 5 fois plus rapide) car plus de classeur temporaire à créer.

Voici la fonction à utiliser GetvisibleRange.

 

[mapomme]

Il y a un truc qui n'a pas été exploité dans la méthode @mapomme.

Je l'avais fait. Mais comme on parlait de protection, je me suis dit que si le classeur est protégé alors la création d'une feuille au sein du classeur serait impossible.
Et je n'ai pas eu la présence d'esprit 😡 de réunir les deux cas dans une seule fonction comme tu l'as fait 👍👌.

 

[dysorthographie]

bonjour,
je comprends que tu souhaites récupérer les range des cellules Visible, mais la finalité est de faire des traitements sur les range en question ou d'en explorer le contenu.

dans le gestionnaire de nom : MaLambda

=LAMBDA(r;
    FILTER(
        r;
        SUBTOTAL(103; OFFSET(r; ROW(r)-MIN(ROW(r)); 0))
    )
)

Dim v As Variant
v = Evaluate("=MaLambda(A1:G100)") 'retourne toutes les valeurs des cellules Visible ne retourne pas les non visibles.

attention il s'agit d'un tableau 1D ou 2D selon la plage de cellules évaluées pas de ranges.

notes que plutôt que d'évaluer dan vba tu peux placer la formule directement dans un feuillet excel.

 

[Dudu2]

@mapomme, la protection du classeur est indépendante de celle des feuilles, alors ça vaut le coup de tenter.
@dysorthographie, je fais des traitements + ou - complexes sur des Ranges ou Selections visibles. Je ne comprends pas la fonction LAMBDA, je n'ai rien de tel.