Option Explicit
Sub Test()
ColLignesOùRelat(CelDéb:=[A2], ColQuoi:="A", OPé:="=", Valeur:="").Formula _
= "=IFERROR(INDEX('RLR'!A:A,MATCH(B2,'RLR'!C:C,0)),"""")"
End Sub
Function ColLignesOùRelat(ByVal CelDéb As Range, ByVal ColQuoi, ByVal OPé As String, ByVal Valeur) As Range
Rem. ——— Cellules partant de CelDéb dans sa colonne où la colonne ColQuoi est en relation Opé avec Valeur.
On Error Resume Next
Set ColLignesOùRelat = Intersect(LignesOùRelat(CelDéb, ColQuoi, OPé, Valeur), CelDéb.EntireColumn)
End Function
Function LignesOùRelat(ByVal LigneDéb As Range, ByVal ColQuoi, ByVal OPé As String, ByVal Valeur) As Range
Rem. ——— Lignes entières partant de LigneDéb où la colonne ColQuoi est en relation Opé avec une Valeur.
If Not IsNumeric(ColQuoi) Then ColQuoi = LigneDéb.Worksheet.Columns(ColQuoi).Column
If VarType(Valeur) = vbString Then Valeur = """" & Replace(Valeur, _
"""", """""") & """" Else Valeur = Trim$(Str$(Valeur))
On Error Resume Next
Set LignesOùRelat = LignesOùCondR1C1(LigneDéb, CondR1C1:="RC" & ColQuoi & OPé & Valeur)
End Function
Function ColLignesOùCondR1C1(ByVal CelDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Cellules partant de CélDéb dans sa colonne dont les lignes vérifient une condition R1C1 CondR1C1.
On Error Resume Next
Set ColLignesOùCondR1C1 = Intersect(LignesOùCondR1C1(CelDéb, CondR1C1), CelDéb.EntireColumn)
End Function
Function LignesOùCondR1C1(ByVal LigneDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Lignes entières partant de LigneDéb vérifiant une condition R1C1 CondR1C1.
Dim Rng As Range
Set Rng = PlageÀPartirDe(LigneDéb.EntireRow): If Rng Is Nothing Then Exit Function
Set Rng = Rng.Columns(Rng.Columns.Count + 1)
Application.ScreenUpdating = False
On Error Resume Next
Rng.FormulaR1C1 = "=1/(" & CondR1C1 & ")"
Set LignesOùCondR1C1 = Rng.SpecialCells(xlCellTypeFormulas, 1).EntireRow
Rng.Delete xlShiftToLeft
End Function
Function PlageÀPartirDe(ByVal CelDéb As Range) As Range
Rem. ——— Plage utilisée à partir de CelDéb.
Dim NbrLig As Long, NBrCol As Long
With CelDéb.Worksheet.UsedRange:
NbrLig = .Row + .Rows.Count - CelDéb.Row
NBrCol = .Column + .Columns.Count - CelDéb.Column
If NbrLig <= 0 Or NBrCol <= 0 Then Exit Function
End With
Set PlageÀPartirDe = CelDéb.Resize(NbrLig, NBrCol)
End Function
