Appliquer formule si cellule vide de la colonne

Bonsoir le forum

Je souhaiterais adapter cette formule.

Si dans la colonne A case vide alors on applique cette formule et on ajoute en plus le contenu de la colonne I sinon on laisse son contenu.

Range("A2:A" & Derlg)="=IFERROR(INDEX('RLR'!A:A,MATCH(B2,'RLR'!C:C,0)),"""")"

Une idée?

Merci

Bonjour,

à tester,

Sub test()
rw = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To rw
 If Range("A" & i) = "" Then
   Range("A" & i).Formula = "=IFERROR(INDEX('RLR'!A:A,MATCH(B" & i & ",'RLR'!C:C,0)),"""")"
 End If
End Sub

Bonsoir.

Ca fonctionnait pas

On m'a indiqué un nouveau module

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

Et là ca fonctionne.

Merci