Calcul après changement de valeur

[Bernard91]

Bonsoir le Forum,
Après plusieurs heures de recherche sans succès, je viens poster cette demande d'aide.
Basiquement, pour 2 colonnes, il y a un coefficient. Je souhaiterais qu'en entrant une valeur dans la colonne de gauche, une multiplication se fasse avec le coefficient et le résultat se positionne sur la même ligne dans la colonne de droite. A l'inverse pour une entrée dans la colonne de droite, une division par le coefficient positionne le résultat dans la colonne de gauche.
Je souhaiterais donc que les calculs se fassent grâce à VBA.
Dans un tableau j'ai plusieurs couples de colonnes fonctionnant de la même manière.
Pour être plus explicite un fichier attaché.
Merci à vous

 

[ODVJ]

Re : Calcul après changement de valeur

Bonsoir,

à mettre derrière ta feuille 1 :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Intersect(Target, Range("$B$21:$B$30")) Is Nothing) Then
    If Intersect(Target, Range("$B$21:$B$30")).Address = Target.Address Then
        Application.EnableEvents = False
        If IsNumeric(Target.Value) And Not (IsEmpty(Target.Value)) Then Target.Offset(0, -1).Value = Target.Value / [B2]
        Application.EnableEvents = True
    End If
End If
If Not (Intersect(Target, Range("$a$21:$a$30")) Is Nothing) Then
    If Intersect(Target, Range("$a$21:$a$30")).Address = Target.Address Then
        Application.EnableEvents = False
        If IsNumeric(Target.Value) And Not (IsEmpty(Target.Value)) Then Target.Offset(0, 1).Value = Target.Value * [B2]
        Application.EnableEvents = True
    End If
End If
End Sub

ça ne gère qu'une zone (A21:B30), donc à adapter.

cordialement

 

[Mytå]

Re : Calcul après changement de valeur

Salut le Forum

Une autre façon de faire

Private Sub Worksheet_Change(ByVal Target As Range)
 
If Not Application.Intersect(Target, Range("A:A,E:E")) Is Nothing Then
  Application.EnableEvents = False
    Target.Offset(0, 1).FormulaR1C1 = "=RC[-1]*R2C2"
  Application.EnableEvents = True
  Exit Sub
End If
 
If Not Application.Intersect(Target, Range("B:B,F:F")) Is Nothing Then
  Application.EnableEvents = False
    Target.Offset(0, -1).FormulaR1C1 = "=RC[1]/R2C2"
  Application.EnableEvents = True
  Exit Sub
End If
 
End Sub

Mytå

 

[Bernard91]

Re : Calcul après changement de valeur

Bonjour le Forum, Myta, ODVJ,
Cela semble correspondre à ma demande, je n'ai pas le temps de le tester; on change ma machine. Si je ne reviens pas c'est que c'est tout bon.
Merci beaucoup