Formules avec cellules dynamiques

[Kernoz]

Bonjour à tous,

J'ai besoin de vos sciences pour un bout de code ...

Voici deja le code de base :

Dim k As Long
With ThisWorkbook.Sheets("Recap")
    For k = .Range("D" & .Rows.Count).End(xlUp).Row To 8 Step -1
        If .Range("D" & k) <> "" Then Range("D" & k).FormulaLocal = "=SI(B9<>"""";SOMMEPROD(('def010415'!$D$6:$D$428=Recap!B9)*('def010415'!$P$6:$P$428))+SOMMEPROD(('def010415'!$D$430:$D$528=Recap!B9)*('def010415'!$P$430:$P$528));"""")"

Next k
End With

Mon soucis, c'est que la formule inserée n'est pas dynamique : c'est toujours =SI(B9 qui s'affiche alors que je voudrais naturellement qu'en ligne 10 ca soit =SI(B10 qui s'affiche ! En gros, je voudrais B,i ou un truc du genre ...

D'avance merci

 

[exene]

Re : Formules avec cellules dynamiques

Bonjour,

As tu essayé d'écrire la formule avec le style de référence L1C1 mais il faudra changer FormulaLocal par FormulaR1C1

@+

 

[Dranreb]

Re : Formules avec cellules dynamiques

Bonjour.

Essayez ça :

Option Explicit

Sub test()
CellsColLgnOù(ThisWorkbook.Worksheets("Recap").[D8], "D", "<>", "").FormulaR1C1 = _
   "=IF(RC2<>"""",SUMPRODUCT(N(def010415!R6C4:R428C4=RC2),def010415!R6C16:R428C16)" _
              & "+SUMPRODUCT(N(def010415!R430C4:R528C4=RC2),def010415!R430C16:R528C16),"""")"
End Sub

Rem. ——— Fonctions utilitaires
Function CellsColLgnOù(ByVal CelDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
Set CellsColLgnOù = Intersect(LignesOù(CelDéb, ColQuoi, Opé, Valeur), CelDéb.EntireColumn)
End Function
Function LignesOù(ByVal LigneDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
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))
Set LignesOù = LignesOùCondR1C1(LigneDéb, "RC" & ColQuoi & Opé & Valeur)
End Function
Function CellsColCondR1C1(ByVal CelDéb As Range, ByVal CondR1C1 As String) As Range
Set CellsColCondR1C1 = 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
Dim Lignes As Range, ColTrv As Range
With LigneDéb.Worksheet.UsedRange
   Set Lignes = LigneDéb.EntireRow.Resize(.Rows.Count + .Row - LigneDéb.Row)
   Set ColTrv = Intersect(.Columns(.Columns.Count + 1), Lignes): End With
ColTrv.FormulaR1C1 = "=1/(" & CondR1C1 & ")"
On Error Resume Next
Set LignesOùCondR1C1 = ColTrv.SpecialCells(xlCellTypeFormulas, 1).EntireRow
ColTrv.Delete xlShiftToLeft
End Function