Créer une formule avec un Step 1 to 100

bloomby · 26 Septembre 2010

Bonjour Forum,
Je cherche à créer une formule à l’aide d’une Macro.
Voici le type de Macro avec laquelle je m’inspire pour la création

Code:

Dim Col As Variant, i As Integer, Lig As Integer, c As Integer
Col = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N" _
, "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC" _
, "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO")
c = 0
For i = 7 To 100 Step 11
  For j = i To i + 1
    For Lig = 50 To Evaluate(ActiveWorkbook.Names("NbRtn").Value) + 49
      Cells(Lig, j).Formula = "=IF(Px!" & Col(c) & Lig - 48 & "<>"""",Px!" & Col(c) & Lig - 48 & "/OFFSET(Px!" & Col(c) & "$1,Model!A19,0)-1,"""")"
    Next
    c = c + 1
  Next
Next
End Sub

Pour ma part la nouvelle formule est du type :

=IF(A52<>"";IF(A50<B50;G50*Rtn!C2;G50*Rtn!B2)+IF(A50>B50;-G50*Rtn!C2;-G50*Rtn!B2);"")

Par la suite puisqu'il y a un step de 11 cellules la formule devient automatiquement la suivante:

=IF(L52<>"";IF(L50<M50;R50*Rtn!N2;R50*Rtn!M2)+IF(L50>M50;-R50*Rtn!N2;-R50*Rtn!M2);"")

Mais devrait plutôt être:

=IF(L52<>"";IF(L50<M50;R50*Rtn!E2;R50*Rtn!D2)+IF(L50>M50;-R50*Rtn!E2;-R50*Rtn!D2);"")

J’ai beau faire plusieurs tentatives mais je suis incapable créer cette macro
Je vous remercie pour votre aide =)

Bloomby

Habitude · 26 Septembre 2010

Re : Créer une formule avec un Step 1 to 100

C à E il y a un écart de 2

Tu as essayé
For i = 7 To 100 Step 2

bloomby · 26 Septembre 2010

Re : Créer une formule avec un Step 1 to 100

Bonjour Habitude,

voici ce que la macro devrait créer comme formule

Dans la Case I50
=IF(A52<>"";IF(A50<B50;G50*Rtn!C2;G50*Rtn!B2)+IF(A50>B50;-G50*Rtn!C2;-G50*Rtn!B2);"")

Case T50
=IF(L52<>"";IF(L50<M50;R50*Rtn!E2;R50*Rtn!D2)+IF(L50>M50;-R50*Rtn!E2;-R50*Rtn!D2);"")

Case AE50
=IF(W52<>"";IF(W50<X50;AC50*Rtn!G2;AC50*Rtn!F2)+IF(W50>X50;-AC50*Rtn!G2;-AC50*Rtn!F2);"")

Case AP50
=IF(AH52<>"";IF(AH50<AI50;AN50*Rtn!I2;AN50*Rtn!H2)+IF(AH50>AI50;-AN50*Rtn!I2;-AN50*Rtn!H2);"")

Et sa continue 😉
merci

job75 · 26 Septembre 2010

Re : Créer une formule avec un Step 1 to 100

Bonjour bloomby, Habitude,

Perso je ferais 5 tableaux correspondant aux 5 lettres des références de la formule :

Code:

t1 = Array("A", "L", "W", "AH", .....)
t2 = Array("B", "M", "X", "AI", .....)
t3 = Array("G", "R", "AC", "AN", .....)
t4 = Array("Rtn!C2", "Rtn!E2", "Rtn!G2", "Rtn!I2", .....)
t5 = Array("Rtn!B2", "Rtn!D2", "Rtn!F2", "Rtn!H2", .....)

Et au lieu d'utiliser un Step de 11 j'utiliserais tout bonnement pour i un Step de 1 permettant de balayer en parallèle les éléments des 5 tableaux.

Pas le temps d'aller plus loin aujourd'hui, demain peut-être...

Mais d'ici là vous aurez peut-être mis au point la macro tout seul, ce n'est pas très difficile, mais assez casse-pied 😉

Edit : j'ai ajouté Rtn!..2 puisque ça ne change pas, ça simplifiera.

A+

job75 · 26 Septembre 2010

Re : Créer une formule avec un Step 1 to 100

Bonsoir bloomby,

Voici des solutions dans 2 hypothèses différentes :

1) la ligne (2) de la feuille Rtn ne varie pas dans la formule :

Code:

Sub Formule1()
Dim t1, t2, t3, t4, t5, derlig&, lig&, i As Byte
t1 = Array("A", "L", "W", "AH", "AS", "BD", "BO", "BZ")
t2 = Array("B", "M", "X", "AI", "AT", "BE", "BP", "CA")
t3 = Array("G", "R", "AC", "AN", "AY", "BJ", "BU", "CF")
t4 = Array("Rtn!C$2", "Rtn!E$2", "Rtn!G$2", "Rtn!I$2", "Rtn!K$2", "Rtn!M$2", "Rtn!O$2", "Rtn!Q$2")
t5 = Array("Rtn!B$2", "Rtn!D$2", "Rtn!F$2", "Rtn!H$2", "Rtn!J$2", "Rtn!L$2", "Rtn!N$2", "Rtn!P$2")
derlig = 100 'à ajuster ou calculer
For lig = 50 To derlig
  For i = 0 To UBound(t1)
    Cells(lig, 9 + 11 * i).Formula = "=IF(" & t1(i) & lig + 2 & "<>"""",IF(" & t1(i) & lig & "<" & t2(i) & lig & "," & t3(i) & lig & "*" & t4(i) & "," & t3(i) & lig & "*" & t5(i) & ")+IF(" & t1(i) & lig & ">" & t2(i) & lig & ",-" & t3(i) & lig & "*" & t4(i) & ",-" & t3(i) & lig & "*" & t5(i) & "),"""")"
  Next
Next
End Sub

2) La ligne de la feuille Rtn se décale d'une ligne à chaque pas :

Code:

Sub Formule2()
Dim t1, t2, t3, t4, t5, derlig&, lig&, i As Byte, r&
t1 = Array("A", "L", "W", "AH", "AS", "BD", "BO", "BZ")
t2 = Array("B", "M", "X", "AI", "AT", "BE", "BP", "CA")
t3 = Array("G", "R", "AC", "AN", "AY", "BJ", "BU", "CF")
t4 = Array("Rtn!C", "Rtn!E", "Rtn!G", "Rtn!I", "Rtn!K", "Rtn!M", "Rtn!O", "Rtn!Q")
t5 = Array("Rtn!B", "Rtn!D", "Rtn!F", "Rtn!H", "Rtn!J", "Rtn!L", "Rtn!N", "Rtn!P")
derlig = 100 'à ajuster ou calculer
For lig = 50 To derlig
  r = lig - 48 'pour la ligne dans Rtn
  For i = 0 To UBound(t1)
    Cells(lig, 9 + 11 * i).Formula = "=IF(" & t1(i) & lig + 2 & "<>"""",IF(" & t1(i) & lig & "<" & t2(i) & lig & "," & t3(i) & lig & "*" & t4(i) & r & "," & t3(i) & lig & "*" & t5(i) & r & ")+IF(" & t1(i) & lig & ">" & t2(i) & lig & ",-" & t3(i) & lig & "*" & t4(i) & r & ",-" & t3(i) & lig & "*" & t5(i) & r & "),"""")"
  Next
Next
End Sub

Attention à bien copier la formule, elle est longue 😉

Edit : j'ai ajouté les signes $ à la 1ère macro, c'est beaucoup mieux...

A+

job75 · 26 Septembre 2010

Re : Créer une formule avec un Step 1 to 100

Re,

S'il y a un grand nombre de lignes, pour éviter le recalcul des formules, il faudra peut-être mettre en début de macro :

Code:

Application.Calculation = xlManual

et en fin de macro :

Code:

Application.Calculation = xlAutomatic

Edit : ce sera peut-être inutile, à vous de voir.

A+

job75 · 27 Septembre 2010

Re : Créer une formule avec un Step 1 to 100

Bonjour bloomby, le forum,

Relisant vos posts, je suis certain que seule la 2ème macro est à utiliser.

Par ailleurs, il est inutile de faire une boucle sur les lignes, il suffit d'entrer d'un coup chaque formule sur l'ensemble des lignes.

Il faut alors 6 tableaux :

Code:

Sub Formule()
Dim t1, t2, t3, t4, t5, t6, derlig&, i As Byte
t1 = Array("A52", "L52", "W52", "AH52", "AS52", "BD52", "BO52", "BZ52", "CK52", "CV52")
t2 = Array("A50", "L50", "W50", "AH50", "AS50", "BD50", "BO50", "BZ50", "CK50", "CV50")
t3 = Array("B50", "M50", "X50", "AI50", "AT50", "BE50", "BP50", "CA50", "CL50", "CW50")
t4 = Array("G50", "R50", "AC50", "AN50", "AY50", "BJ50", "BU50", "CF50", "CQ50", "DB50")
t5 = Array("Rtn!C2", "Rtn!E2", "Rtn!G2", "Rtn!I2", "Rtn!K2", "Rtn!M2", "Rtn!O2", "Rtn!Q2", "Rtn!S2", "Rtn!U2")
t6 = Array("Rtn!B2", "Rtn!D2", "Rtn!F2", "Rtn!H2", "Rtn!J2", "Rtn!L2", "Rtn!N2", "Rtn!P2", "Rtn!R2", "Rtn!T2")
derlig = 100 'à ajuster ou calculer
For i = 0 To UBound(t1)
  Cells(50, 9 + 11 * i).Resize(derlig - 49).Formula = "=IF(" & t1(i) & "<>"""",IF(" & t2(i) & "<" & t3(i) & "," & t4(i) & "*" & t5(i) & "," & t4(i) & "*" & t6(i) & ")+IF(" & t2(i) & ">" & t3(i) & ",-" & t4(i) & "*" & t5(i) & ",-" & t3(i) & "*" & t6(i) & "),"""")"
Next
End Sub

Nota : j'ai ajouté 2 éléments supplémentaires à chaque tableau.

A+

job75 · 28 Septembre 2010

Re : Créer une formule avec un Step 1 to 100

Bonjour bloomby, le forum,

Je repasse par là avec une dernière solution.

Les addresses se suivant régulièrement, on peut se passer des 6 tableaux :

Code:

Sub Formule()
Dim derlig&, ncol As Byte, i As Byte, a1$, a2$, a3$, a4$, a5$, a6$
derlig = 100 'à ajuster ou calculer
ncol = 10 'nombre de colonnes à remplir
For i = 0 To ncol - 1
  a1 = [A52].Offset(, 11 * i).Address(0, 0) '(0, 0) donne des références relatives
  a2 = [A50].Offset(, 11 * i).Address(0, 0)
  a3 = [B50].Offset(, 11 * i).Address(0, 0)
  a4 = [G50].Offset(, 11 * i).Address(0, 0)
  a5 = "Rtn!" & [C2].Offset(, 2 * i).Address(0, 0)
  a6 = "Rtn!" & [B2].Offset(, 2 * i).Address(0, 0)
  Cells(50, 9 + 11 * i).Resize(derlig - 49).Formula = "=IF(" & a1 & "<>"""",IF(" & a2 & "<" & a3 & "," & a4 & "*" & a5 & "," & a4 & "*" & a6 & ")+IF(" & a2 & ">" & a3 & ",-" & a4 & "*" & a5 & ",-" & a3 & "*" & a6 & "),"""")"
Next
End Sub

A+

Créer une formule avec un Step 1 to 100

bloomby

XLDnaute Occasionnel

Habitude

XLDnaute Accro

bloomby

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires

Créer une formule avec un Step 1 to 100

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency