Option Explicit
Function ReperePlageVisible_L950_V4_VarianteCellsTab(Wks As Worksheet) As Collection
' Prend la feuille (active Wks) en paramètre
' Retourne la Collection contenant toutes les zones de cellules visibles :
' - ligne par ligne
'
' Déclaration des variables
Dim UniondRng As Range ' ................ Stocke le UsedRange de la feuille (zone réellement utilisée).
Dim ColDept As Long ' ................... C'est la premiére colonne de la zone visible sur la ligne courante "UniondRng".
Dim colFin As Long ' .................... C'est la derniere colonne de la zone visible sur la ligne courante "UniondRng".
Dim PlageVisible As New Collection ' .... C'est cette Collection qui stock chaque UniondRng visible contigu par ligne.
Dim Lig As Long ' ....................... C'est le Compteur des boucles des lignes
Dim Col As Long ' ....................... C'est le Compteur des boucles des Colonnes
Dim PremCol As Long ' ................... C'est le Bornage des colonnes (Preméire Colonne) utilisées dans cette feuille
Dim DerCol As Long ' .................... C'est le Bornage des colonnes (Derniére Colonne) utilisées dans cette feuille
'
On Error Resume Next ' .................. Au cas ou la feuille est vide ! (Sécurité d'une Gestion d'Erreur).
Set UniondRng = Wks.UsedRange ' ..... Stocks (Toutes les plages de la feuille)
On Error GoTo 0
'
If UniondRng Is Nothing Then Exit Function ' ................. Fin de la VBA si aucune cellule remplis !
'
PremCol = UniondRng.Columns(1).Column '...................... C'est le Bornage des colonnes (Preméire Colonne) utilisées dans cette feuille
DerCol = UniondRng.Columns(UniondRng.Columns.Count).Column ' . C'est le Bornage des colonnes (Derniére Colonne) utilisées dans cette feuille
'
' Parcours toutes les lignes de "UniondRng" :
' Les lignes sans cellules non vides ne génèrent aucune plage.
' Exemple : Plage 1 (B6:B31) ' Lignes 6 à 31
' ' la ligne 5 Est totalement vide donc (pas prise en compte)
' Plage 2 (E2:E4) ' Ligne 2 à 4
' Parcours des lignes "UniondRng" soit : 2 à 4 (Plage 1) | La ligne 5 exclus | Puis de 6 à 31 (Plage 2)
' Stock les colonnes masquées (1 fois) dans la variable tableau
Dim ColHidden() As Boolean
Dim c As Long
ReDim ColHidden(PremCol To DerCol)
For c = PremCol To DerCol
ColHidden(c) = Wks.Columns(c).Hidden
Next c
Dim TabLig As Variant
Dim RngLig As Range
For Lig = UniondRng.Row To UniondRng.Row + UniondRng.Rows.Count - 1
' Boucle sur toutes les lignes utilisées.
If Wks.Rows(Lig).Hidden Then GoTo LigneSuivante ' Ignore les lignes masquées
' Optimisation 4
' sert a tester si la ligne est totalement vide avec Application.CountA(LaVariable)
Set RngLig = Wks.Range(Wks.Cells(Lig, PremCol), Wks.Cells(Lig, DerCol))
If Application.CountA(RngLig) = 0 Then GoTo LigneSuivante
' Charge la ligne en mémoire (si contient au moins une valeur
TabLig = RngLig.Value
ColDept = 0 ' Réinitialisation : Colonne à 0.
' Parcours colonne par colonne dans la ligne courante de "UniondRng" :.
' Exclus les Colonnes totalement vide.
'For Col = PremCol To DerCol
For Col = 1 To UBound(TabLig, 2)
'Dim CelNotEmpty As Variant
'CelNotEmpty = Wks.Cells(Lig, Col).Value
'If Not Wks.Columns(Col).Hidden Then ' Ignore les Colonnes masquées
'If Not Wks.Columns(PremCol + Col - 1).Hidden Then
If Not ColHidden(PremCol + Col - 1) Then
' Démarre ou étend une zone contiguë visible.
If ColDept = 0 Then
'If Wks.Cells(Lig, Col) <> Empty Then ' Tester si cellule non vide.
'If CelNotEmpty <> Empty Then ' Tester si cellule non vide.
'If TabLig(1, Col) <> Empty Then
If LenB(TabLig(1, Col)) <> 0 Then
'ColDept = Col ' Premiére Colonne de la plage "UniondRng"
ColDept = PremCol + Col - 1
End If
End If
'If Wks.Cells(Lig, Col) <> Empty Then ' Tester si cellule non vide.
'If CelNotEmpty <> Empty Then ' Tester si cellule non vide.
'If TabLig(1, Col) <> Empty Then
If LenB(TabLig(1, Col)) <> 0 Then
'colFin = Col ' Derniére Colonne de la plage "UniondRng"
colFin = PremCol + Col - 1
End If
Else ' Colonne masquée ? fin de zone visible.
' Fin de zone contiguë visible
If ColDept > 0 Then
' Enregistre la zone visible détectée dans la collection
PlageVisible.Add Wks.Range(Wks.Cells(Lig, ColDept), Wks.Cells(Lig, colFin))
ColDept = 0
End If
End If
Next Col
' Cas où la ligne se termine sur une colonne visible
' Ajouter la zone en fin de ligne
If ColDept > 0 Then
' Stock la plage dans la collection
PlageVisible.Add Wks.Range(Wks.Cells(Lig, ColDept), Wks.Cells(Lig, colFin))
End If
LigneSuivante:
Next Lig
' Retour de la fonction
Set ReperePlageVisible_L950_V4_VarianteCellsTab = PlageVisible ' Cette collection contient l'ensemble des plages visibles.
End Function
' Exemple d'utilisation
Sub PlageVisible_V4()
Dim Col As Collection
Dim Rng As Range
Dim Msg As String
'
' Fonction : Stocks toutes les cellules visibles dans la collection "Col"
Set Col = ReperePlageVisible_L950_V4_VarianteCellsTab(ActiveSheet)
'
If Col.Count = 0 Then
MsgBox "Aucune cellule visible"
Exit Sub
End If
'
Msg = "Cellule Visibles :" & vbCrLf
For Each Rng In Col
Msg = Msg & Rng.Address(0, 0) & vbCrLf
Next Rng
' MsgBox Msg
'
End Sub