pour le fun, une fonction retournant une plage de cellules ou de lignes pair impair au sein d'une plage
Public Function Rg2Shred(rg As Range, pair As Boolean, Optional entierete As Boolean, Optional DebutReel As Boolean, Optional FinReelle As Boolean) As Range
Application.Volatile (False)
If rg.Areas.Count > 1 Then Exit Function
Dim rgC As Range 'cible
Dim rgS As Range 'source
Dim fS As Integer 'valeur initiale de la boucle for
Dim rgD As Range 'début de la plage source
Dim rgF As Range 'fin de la plage source
fS = IIf(pair = True, 2, 1) 'si pair = vrai, démarrage à la 2nde ligne de la plage, sinon à la 1°
Set rgD = rg.Item(1) 'détermination de la première cellule de la plage
Set rgF = LastCellCurrentPage(rg) 'détermination de la dernière cellule de la plage
'déterminations éventuelles des cellules réélles de débuts et de fin
'If Not IsMissing(DebutReel) Then If DebutReel Then Set rgD = rg.Find('*', rg.Item(1), , , xlByRows, xlNext)
'If Not IsMissing(FinReelle) Then If FinReelle Then Set rgF = rg.Find('*', rg.Item(1), , , xlBycolumn, xlPrevious)
Set rgS = Range(rgD, rgF) 'détermination de la plage ciblée
For i = fS To rgS.Rows.Count Step 2
If rgC Is Nothing Then
Set rgC = rgS.Rows(i) 'au premier tour, rgC sera vide
Else
Set rgC = Union(rgC, rgS.Rows(i)) 'puis, union de la plage existante dans rgC avec la ligne 'lue'
End If
Next i
'si une plage a été construite, elle est retournée, composée de ligne entière, si entierete = vrai
If Not rgC Is Nothing Then If entierete Then Set Rg2Shred = rgC.EntireRow Else Set Rg2Shred = rgC
End Function
' les astuces :
' écrire directement l'appel dans la zone nom pour sélectionner la plage en question
' exemple : Rg2Shred(A1:C15;vrai;vrai)
'
' définir un nom sous forme de formule employant cette fonction avec une adresse absolue,
' pour sélectionner rapidement une plage donnée via ensuite la zone nom
' exemple de nom : test =Rg2Shred($A$1:$C$15;vrai;vrai)
' même si vous ne voyez pas le nom dans la liste déroulante de la zone niom, vous pouvez
' taper directement le nom
' que faire de plus :
'- comment déclarer rg pour ne pas que l'utilisateur puisse sélectionner des plages multiples
'- retourner des codes erreurs ou libellés d'erreur précises
'- si la fonction est appelée seule en directe depuis une cellule, retourner le libellé de l'adresse (ou passer un paramètre pour retourner l'adresse et nom l'objet)
'- changer la gestion de la boucle, pour un pas de X (et transformer le paramètre pair en pas) ?
'- pour le fun, pas aléatoire (changeant à chaque boucle) : pas faisable avec une boucle for
'- corriger la détermination des cellules réelles de fin et de début
'- je pense que c'est mieux de la laisser non volatile
Function LastCellCurrentPage(cell As Range) As Range
Dim derLi, derCol
derLi = cell.CurrentRegion.Row + _
cell.CurrentRegion.Rows.Count - 1
derCol = cell.CurrentRegion.Column + _
cell.CurrentRegion.Columns.Count - 1
Set LastCellCurrentPage = Cells(derLi, derCol)
End Function
