Autres Modifier une macro pour l'appliquer à une boucle

Elisa47

XLDnaute Nouveau
Bonjour le forum,

J'ai une macro qui me permet de calculer une valeur cible.
Aujourd'hui cette macro fonctionne uniquement pour la ligne 17.
Je souhaiterai modifier cette macro avec une boucle pour l'appliquer de la ligne 17 à la ligne 138 et que le résultat obtenu soit un multiple de 25 arrondi au supérieur.
Voici mon code :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If [BE17] < 0 Then [BE17] = 0
If Not Intersect(Target, [E17,F17,G17,M17,BD17]) Is Nothing Then [BI17].GoalSeek Goal:=0, ChangingCell:=[BE17]
Application.ScreenUpdating = True
End Sub
De plus, est-il possible que cette macro fonctionne uniquement si la valeur de la cellule G17 et des lignes suivantes soit égale à "Acier galvanisé rectangulaire" ou "Fibre de verre". Le contenu de cette cellule peut varier d'une ligne à l'autre.
Merci pour votre aide
 

Pièces jointes

  • Exemple.xlsm
    187.9 KB · Affichages: 12

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Elisa,
Un premier essai en PJ avec :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim L As Integer
Application.ScreenUpdating = False
If Not Intersect(Target, Range("E17:E138,F17:F138,G17:G138,M17:M138,BD17:BD138")) Is Nothing Then
    L = Target.Row
    If Range("G" & L) = "Acier galvanisé rectangulaire" Or Range("G" & L) = "Fibre de verre" Then
        Application.EnableEvents = False
        If Range("BE" & L) < 0 Then Range("BE" & L) = 0
        Range("BI" & L).GoalSeek Goal:=0, ChangingCell:=Range("BE" & L)
        Range("BE" & L) = Application.WorksheetFunction.RoundUp(Range("BE" & L), 25)
        Application.EnableEvents = True
    End If
End If
Application.ScreenUpdating = True
End Sub
Si j'ai bien compris la demande. Ce qui est loin d'être sûr. :rolleyes:
 

Pièces jointes

  • Exemple (6).xlsm
    189 KB · Affichages: 4

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 937
Membres
101 844
dernier inscrit
pktla