XL 2016 Exécuter une macro dans une colonne

[GhostInTheShell]

Bonjour,
Tout d'abord, sachez que j'ai cherché sans trouver la solution qui pourtant doit être simple.
J'ai créer une macro pour effectuer un calcul dans une colonne par contre, je ne sais plus comment faire en sorte qu'elle s'exécute dans la colonne 22 de mon classeur A... HELP!!!

Sub IDR()

Dim A As Worksheet
Dim I As Integer
Set A = Sheets("CALCUL")

For I = 2 To 20000

If A.Cells(I, 16) = "TPC" And A.Cells(I, 19) < 2 Then
cellformule = (A.Cells(I, 19)) * ((0))
ElseIf A.Cells(I, 16) = "TPC" And A.Cells(I, 19) < 10 Then
cellformule = (A.Cells(I, 19) - 2) * ((1.5 / 10))
ElseIf A.Cells(I, 16) = "TPC" And A.Cells(I, 19) > 10 Then
cellformule = ((A.Cells(I, 19) - 2) * ((1.5 / 10)) + (A.Cells(I, 19) - 10) * ((3 / 10)))
ElseIf A.Cells(I, 16) = "TPE" And A.Cells(I, 19) < 2 Then
cellformule = (A.Cells(I, 19)) * ((0))
ElseIf A.Cells(I, 16) = "TPE" And A.Cells(I, 19) < 10 Then
cellformule = (A.Cells(I, 19) - 2) * ((1 / 10))
ElseIf A.Cells(I, 16) = "TPE" And A.Cells(I, 19) > 10 Then
cellformule = ((A.Cells(I, 19) - 2) * ((1 / 10)) + (A.Cells(I, 19) - 10) * ((1.5 / 10)))
ElseIf A.Cells(I, 16) = "TPO" And A.Cells(I, 19) < 10 Then
cellformule = (A.Cells(I, 19)) * ((0))

End If
Next

End Sub

 

[eriiic]

Bonjour,

fait F1 sur Cells
eric

PS : tu as cherché, il te suffisait de relire ta question de 2015 : https://www.excel-downloads.com/threads/macro-pour-remplir-tableau.234089/#post-1496102

 

[GhostInTheShell]

Pas le même problème. Dans l'autre il s'agissait d'une case dans une grille, là il s'agit d'appliquer une formule sur une colonne. A moins qu'une subtilité m'échappe.

 

[eriiic]

Tu as fait F1 sur Cells ? La réponse y est

 

[Patrice33740]

[...] là il s'agit d'appliquer une formule sur une colonne. A moins qu'une subtilité m'échappe.

A moi aussi, une subtilité m'échappe !
Ta macro n'applique pas de formule sur une colonne, elle calcule la valeur numérique d'une variable (non déclarée) nommée cellformule d'après les valeurs de certaines cellules. Et ensuite, elle ne fait rien du résultat obtenu !

Tu devrais positionner ton curseur sur Cells et faire F1 pour voir quelles sont ses propriétés

 

[GhostInTheShell]

Effectivement, cellformule n'est pas correct
Je reprends la formule.
Merci

 

[GhostInTheShell]

Bonjour à tous,
J'ai travaillé la formule sur la base des recommandations et j'ai pu avancer d'un grand pas. Voilà le résultat ci-dessous.

Par contre, à l'exécution, les conditions avec A.cells sur "TPC" et <> ne fonctionnent pas. En effet, à la fin du calcul, peu importe si c'est TPC TPE ou autre chose, j'ai la même formule partout.

Une idée sur ce qui cloche?

Merci par avance,

Sub IDR()

Dim A As Worksheet
Dim I As Integer
Set A = Sheets("CALCUL")

For I = 2 To 20000

'Travaux Publics France

If A.Cells(I, 16) = "TPC" And A.Cells(I, 19) < 2 Then
A.Range("v2:v" & Range("a20000").End(xlUp).Row).FormulaR1C1 = "=(RC[-3]*0)"
ElseIf A.Cells(I, 16) = "TPC" And A.Cells(I, 19) < 10 And A.Cells(I, 19) > 2 Then
A.Range("v2:v" & Range("a20000").End(xlUp).Row).FormulaR1C1 = "=(RC[-3]-2) * ((1.5 / 10))"
ElseIf A.Cells(I, 16) = "TPC" And A.Cells(I, 19) > 10 Then
A.Range("v2:v" & Range("a20000").End(xlUp).Row).FormulaR1C1 = "=(((RC[-3]-2) * (1.5 / 10)) + ((RC[-3]- 10) * (3 / 10)))"
ElseIf A.Cells(I, 16) = "TPE" And A.Cells(I, 19) < 2 Then
A.Range("v2:v" & Range("a20000").End(xlUp).Row).FormulaR1C1 = "=(RC[-3]*0)"
ElseIf A.Cells(I, 16) = "TPE" And A.Cells(I, 19) < 10 And A.Cells(I, 19) > 2 Then
A.Range("v2:v" & Range("a20000").End(xlUp).Row).FormulaR1C1 = "=(RC[-3]-2) * ((1 / 10))"
ElseIf A.Cells(I, 16) = "TPE" And A.Cells(I, 19) > 10 Then
A.Range("v2:v" & Range("a20000").End(xlUp).Row).FormulaR1C1 = " =(RC[-3]-2) * ((1 / 10)) + (RC[-3]- 10) * ((1.5 / 10))"
ElseIf A.Cells(I, 16) = "TPO" Then
A.Range("v2:v" & Range("a20000").End(xlUp).Row).FormulaR1C1 = "=(RC[-3]*0)"

End If
Next

End Sub

 

[Patrice33740]

Bonjour,

[...]Par contre, à l'exécution, les conditions avec A.cells sur "TPC" et <> ne fonctionnent pas. En effet, à la fin du calcul, peu importe si c'est TPC TPE ou autre chose, j'ai la même formule partout.

C'est normal, c'est ce que tu as demandé :

Pas le même problème. Dans l'autre il s'agissait d'une case dans une grille, là il s'agit d'appliquer une formule sur une colonne. A moins qu'une subtilité m'échappe.

1) Je penses qu'il est temps que tu expliques en détail ce que tu voudrais faire, éventuellement avec un ou plusieurs exemples !
2) Pourquoi mettre une formule comme .FormulaR1C1 = "=(RC[-3]*0)" Je ne vois pas l'intérêt de faire exécuter ce calcul par Excel quand il suffit de mettre.FormulaR1C1 = "0"

 

[GhostInTheShell]

Ok, je reprends à 0.

je mets en place une simulation pour provisionner les indemnités de fin de carrière. J'ai 20000 salariés dans 8 conventions collectives différentes avec environ 20 manières différentes de calculer les indemnités de retraite. Ces indemnités dépendent de l'ancienneté du salarié (le fameux RC[-3]).
Au final, rien que pour les travaux publics, tu as une formule pour les moins de 2 ans d'ancienneté, une formule pour les 2 à 10 ans d'ancienneté et une pour les plus de 10 ans avec des multiplicateurs différents suivant si ta catégorie socio professionnelles.

Je voulais juste automatiser les calculs et en faire apparaître le résultat dans ma colonne dédiée.

Au lieu de passer par une macro peut être faut il mieux que je passe par une function().

Voilà mais le seul problème est que dès le départ il y a eu une discordance an rapprochant cette demande dune réalisée en 2015 qui n'a pas le même objet.
En espérant avoir été clair pour le coup

Merci

 

[Patrice33740]

Re,

Donc tu ne veux pas une mais plusieurs formules différentes selon le cas. Je pense que c'est une erreur de procéder ainsi.
Il y a deux possibilité :
- soit tu utilises une seule et même formule qui envisage tous les cas possibles
- soit tu mets directement le résultat du calcul comme ceci:

Option Explicit
Sub IDR()
Dim A As Worksheet
Dim I As Long
Dim D As Long
Dim V As Long
  Set A = Worksheets("CALCUL")
  D = A.Cells(A.Rows.Count, "P").End(xlUp).Row
  For I = 2 To D
  'Travaux Publics France
  V = A.Cells(I, "S").Value
  If A.Cells(I, "P").Value = "TPC" Then
  If V < 2 Then
  A.Cells(I, "V").Value = 0
  ElseIf V < 10 Then
  A.Cells(I, "V").Value = (V - 2) * 1.5 / 10
  Else  'V >= 10
  A.Cells(I, "V").Value = (V - 2) * 1.5 / 10 + (V - 10) * 3 / 10
  End If
  ElseIf A.Cells(I, "P").Value = "TPE" Then
  If V < 2 Then
  A.Cells(I, "V").Value = 0
  ElseIf V < 10 Then
  A.Cells(I, "V").Value = (V - 2) / 10
  Else  'V >= 10
  A.Cells(I, "V").Value = (V - 2) / 10 + (V - 10) * 1.5 / 10
  End If
  ElseIf A.Cells(I, "P").Value = "TPO" Then
  A.Cells(I, "V").Value = 0
  End If
  Next
End Sub

EDIT : Ou avec une seule et même formule (mais dans ce cas on peut se passer de la macro):

Sub IDR()
Dim A As Worksheet
Dim F As String
Dim D As Long
  Set A = Worksheets("CALCUL")
  D = A.Cells(A.Rows.Count, "P").End(xlUp).Row
  F = "=IF(RC[-6]=""TPC"",IF(RC[-3]<2,0,IF(RC[-3]<10,(RC[-3]-2)*1.5/10,(RC[-3]-2)*1.5/10+(RC[-3]-10)*3/10))," & _
       "IF(RC[-6]=""TPE"",IF(RC[-3]<2,0,IF(RC[-3]<10,(RC[-3]-2)/10,(RC[-3]-2)/10+(RC[-3]-10)*1.5/10))," & _
       "IF(RC[-6]=""TPO"",0,"""")))"
  A.Range("V2:V" & D).FormulaR1C1 = F
End Sub

 

[GhostInTheShell]

Bonjour,

Merci. Effectivement, je n'étais pas du tout sur la bonne voie. ça marche. Bon, il ne me reste plus qu'à dupliquer pour les autres conventions!

Bonne journée

 

[Dranreb]

Bonjour.
Voyez si cette fonction perso ne serait pas plus facile à manier :

Function TrchPrc(ByVal X As Double, ByVal TXY, _
   Optional ByVal C1 As Long = -1) As Double
Dim C0 As Long, L As Long, X0 As Double, X1 As Double, Y0 As Double
If TypeOf TXY Is Range Then TXY = TXY.Value
C0 = LBound(TXY, 2): If C1 = -1 Then C1 = UBound(TXY, 2)
For L = LBound(TXY, 1) To UBound(TXY, 1)
   X1 = TXY(L, 1): If X <= X1 Then Exit For
   TrchPrc = TrchPrc + (X1 - X0) * Y0 / 100
   X0 = X1: Y0 = TXY(L, 2): Next L
TrchPrc = TrchPrc + (X - X0) * Y0 / 100
End Function

 

[Dranreb]

Exemple d'utilisation :

Sub IDR()
Dim A As Worksheet
Dim F1 As String, F2 As String
Dim D As Long
  Set A = Worksheets("CALCUL")
  D = A.Cells(A.Rows.Count, "P").End(xlUp).Row
  F1 = "=IF(RC[-6]=""TPC"",IF(RC[-3]<2,0,IF(RC[-3]<10,(RC[-3]-2)*1.5/10,(RC[-3]-2)*1.5/10+(RC[-3]-10)*3/10))," & _
       "IF(RC[-6]=""TPE"",IF(RC[-3]<2,0,IF(RC[-3]<10,(RC[-3]-2)/10,(RC[-3]-2)/10+(RC[-3]-10)*1.5/10))," & _
       "IF(RC[-6]=""TPO"",0,"""")))"
  F2 = "=IF(RC16=""TPC"",TrchPrc(RC19,{2,15;10,30})," _
      & "IF(RC16=""TPE"",TrchPrc(RC19,{2,10;10,15})," _
      & "IF(RC16=""TPO"",0,"""")))"
  A.Range("V2:V" & D).FormulaR1C1 = F1
  A.Range("W2:W" & D).FormulaR1C1 = F2 ' Colonne W pour essai et comparaison avec colonne V
End Sub

 

[Dranreb]

Autre façon de l'utiliser :

Function TrchIDR(ByVal TP As String, ByVal V As Double)
Select Case TP
   Case "TPC": TrchIDR = TrchPrc(V, Tab2Col(2, 15, 10, 30))
   Case "TPE": TrchIDR = TrchPrc(V, Tab2Col(2, 10, 10, 15))
   Case "TPO": TrchIDR = 0: Case Else: TrchIDR = "": End Select
End Function
Function Tab2Col(ParamArray Valeurs() As Variant) As Variant()
RemplirArrayExcel Tab2Col, 2, Valeurs
End Function
Sub RemplirArrayExcel(ArrayExcel(), ByVal NbCol As Long, ByVal Valeurs As Variant)
Dim L As Long, C As Long, Valeur
ReDim ArrayExcel(1 To (UBound(Valeurs) + NbCol) \ NbCol, 1 To NbCol)
For Each Valeur In Valeurs
   C = C Mod NbCol + 1: If C = 1 Then L = L + 1
   ArrayExcel(L, C) = Valeur: Next Valeur
End Sub

Et en colonne V à partir de ligne 2 :

=TrchIDR(P2;S2)

De prime abord tout ça pourrait vous sembler plus compliqué.
L'intérêt n'apparaîtrait que si les bornes et pourcentages devaient changer, voire s'il fallait en ajouter.
La formulation est plus simple parce qu'on n'indique que les chiffres au lieu de SI imbriqués.