XL 2016 Insérer une formule en VBA

[luke3300]

Bonjour à tous,

Je coince sur un problème d'insertion/de recopie de formule ...

J'aimerais insérer via une macro la formule suivante en cellule I8 de mon classeur:

=SI($E8="X","","1")

Et faire étirer ou coller la formule jusqu'à la dernière ligne du classeur contenant des valeurs en colonne B.

Par exemple si la dernière cellule de la colonne B contenant des valeurs est la B46859, j'aimerais que la formule soit copiée de I8 à I46859.

J'ai fais un petit fichier que je joints pour essayer de mieux visualiser le hic.

Très bon dimanche à tous

 

[pierrejean]

Re

Macro a tester

Sub recopie()
Application.ScreenUpdating = False
derlin = Range("B" & Rows.Count).End(xlUp).Row
ReDim tablo(derlin - 9, 1)
debform = "=SI($E"
finform = "=""X"";"""";""1"")"
a = 9
For n = LBound(tablo, 1) To UBound(tablo, 1)
   tablo(n, 1) = debform & a & finform
   a = a + 1
Next
For n = LBound(tablo, 1) To UBound(tablo, 1)
   Range("I" & n + 9).FormulaLocal = tablo(n, 1)
Next
Application.ScreenUpdating = True
End Sub

 

[luke3300]

Re

Macro a tester

Sub recopie()
Application.ScreenUpdating = False
derlin = Range("B" & Rows.Count).End(xlUp).Row
ReDim tablo(derlin - 9, 1)
debform = "=SI($E"
finform = "=""X"";"""";""1"")"
a = 9
For n = LBound(tablo, 1) To UBound(tablo, 1)
   tablo(n, 1) = debform & a & finform
   a = a + 1
Next
For n = LBound(tablo, 1) To UBound(tablo, 1)
   Range("I" & n + 9).FormulaLocal = tablo(n, 1)
Next
Application.ScreenUpdating = True
End Sub

Hello pierrejean,

J'obtiens ceci ...

 

[luke3300]

J'avais recopier la formule essaie comme ceci
zone.FormulaR1C1 = "=IF(RC[-4]=""X"","""",""1"")"

Résultat obtenu Merciiiiiiiii à tous!
Mais avec un de trop ... regardes ... que dois-je changer pour qu'il s'arrête une ligne avant?

 

[sousou]

en leve le +1 dans cette ligne
If k <> "" Then dernièrelg = k.Row + 1 Else dernièrelg = 1

 

[luke3300]

Au top!!!

Merci beaucoup sousou, pierrejean, M12 et le le forum.

Excellente soirée à tous.

 

[luke3300]

Bonjour sousou, le forum,

Je reviens vers vous car quand j'ai tenté d'incorporer le code dans mon fichier original, j'arrive à un résultat différent ...

En photo, le contenu VBA de mon fichier et le résultat obtenu en activant la macro ... en fait au lieu de commencer l'opération à partir de la cellule I8, le code démarre en I1 pour terminer en I8 ... Aurais-je fait une erreur en recopiant ou???
Je précise que je l'ai mis en "module" plutôt que sur la feuille car à l'ouverture du fichier, la feuille "All" n'existe pas. Elle est ajoutée par une macro avant d'utiliser cette macro-ci.
Merci pour vos lumières et bon lundi.

 

[cathodique]

Bonjour Luke3300,

Dans la fonction tu lui imposes la ligne 1

If k <> "" Then dernièrelg = k.Row Else dernièrelg = 1

Corrige dernièrelg=8 au lieu de 1, ça devrait fonctionner.

Bonne journée.

 

[luke3300]

Bonjour cathodique,

En adaptant à la ligne 8 la macro fonctionne ... pour la ligne 8 et pas les autres ...

Une autre idée?

Bonne journée et merci surtout

 

[cathodique]

Re,

un essai

Sub ActifCalc()
  Dim drl As Long
  With Sheets("all")
  drl = .Range("B" & Rows.Count).End(xlUp).Row
  Set zone = .Range(.Cells(8, 9), .Cells(drl, 9))
  zone.FormulaR1C1 = "=if(rc[-4]=""X"","""",""1"")"
  End With
End Sub

 

[job75]

Bonjour à tous,

Laborieux ce fil, pourtant avec les Application.Match (EQUIV) c'est assez simple :

Sub RemplirColonne()
Dim deb As Range, derlig1 As Long, derlig2 As Long, derlig As Long
With Sheets("All") 'à adapter
    Set deb = .[I8] 'à adapter
    On Error Resume Next
    derlig1 = Application.Match("zzz", .Columns("B"))
    derlig2 = Application.Match(9 ^ 9, .Columns("B"))
    On Error GoTo 0
    derlig = IIf(derlig1 > derlig2, derlig1, derlig2)
    Application.ScreenUpdating = False
    deb.Resize(.Rows.Count - deb.Row + 1).ClearContents 'RAZ
    If derlig >= deb.Row Then
        deb = "=IF(E" & deb.Row & "=""X"","""",1)"
        deb.AutoFill deb.Resize(derlig - deb.Row + 1)
    End If
End With
End Sub

A+

 

[luke3300]

Re,

un essai

Sub ActifCalc()
  Dim drl As Long
  With Sheets("all")
  drl = .Range("B" & Rows.Count).End(xlUp).Row
  Set zone = .Range(.Cells(8, 9), .Cells(drl, 9))
  zone.FormulaR1C1 = "=if(rc[-4]=""X"","""",""1"")"
  End With
End Sub

Super ça fonctionne nickel! merci cathodique et bonne soirée.

 

[luke3300]

Bonjour à tous,

Laborieux ce fil, pourtant avec les Application.Match (EQUIV) c'est assez simple :

Sub RemplirColonne()
Dim deb As Range, derlig1 As Long, derlig2 As Long, derlig As Long
With Sheets("All") 'à adapter
    Set deb = .[I8] 'à adapter
    On Error Resume Next
    derlig1 = Application.Match("zzz", .Columns("B"))
    derlig2 = Application.Match(9 ^ 9, .Columns("B"))
    On Error GoTo 0
    derlig = IIf(derlig1 > derlig2, derlig1, derlig2)
    Application.ScreenUpdating = False
    deb.Resize(.Rows.Count - deb.Row + 1).ClearContents 'RAZ
    If derlig >= deb.Row Then
        deb = "=IF(E" & deb.Row & "=""X"","""",1)"
        deb.AutoFill deb.Resize(derlig - deb.Row + 1)
    End If
End With
End Sub

A+

Bonsoir job75 et merci pour ton aide
Et bien sur, résultat au top aussi!
J'adopte les 2, c'est toujours utile
Excellente soirée à vous toutes et tous et encore merci.