Calcul automatique VBA

Bonjour,

Je vous explique mon problème, je souhaiterais qu'en saisissant le montant TTC dans ma cellule ce soit le montant HT qui s'affiche.

J'ai trouvé ce code en cherchant sur internet, cependant j'ai plusieurs problématiques : voir ci-dessous

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Selection.Count = 1 _
    And Target.Column >= 3 _
    And Target.Column <= 15 _
    And IsNumeric(Target.FormulaLocal) _
    Then
        Target.Formula = "=" & Target.Value & "/1.2"
    End If
End Sub

- j'aurais souhaiter savoir comment affecter plusieurs colonnes à cette formule de calcule ? Je m'explique je souhaite que la formule "/1.2" soit uniquement affecter aux colonnes B1:B50, D1:50 etc.

-Je souhaiterais également savoir s'il était possible de faire des calculs dans la cellule ? J'ai fait plusieurs essais c'est à dire que par exemple :
Si j'ai écrit dans la cellule B2 : 200€ et que je change de cellule la formule /1.2 va bien s'appliquer. Cependant si je reviens dans ma cellule B2 et que je modifie ma formule afficher =200/1.2 par =200+500, la formule /1.2 ne s'applique plus. J'imagine que c'est parce qu'elle a déjà été appliqué sur cette cellule. Est-ce qu'il y a un moyen de faire pour que cela fonctionne ?

-Est-ce que je peux choisir les feuilles sur lesquelles appliquer le code ?

Est-ce qu'il y a un moyen de faire pour que cela fonctionne ?

Je suis débutante en VBA et j'ai besoin de votre aide. Pourriez-vous m'aider à modifier ce code ou avez-vous d'autres idées ?

Merci par avance ;-)

Bonjour,

La macro modifiée:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Selection.Count = 1 And Target.Column >= 3 And Target.Column <= 15 Then
        Target.Formula = "=" & Target.Value & "/1.2"
    End If
Sortie:
    Application.EnableEvents = True
End Sub

-Est-ce que je peux choisir les feuilles sur lesquelles appliquer le code ? OUI

2 cas de figure:

-1er cas, vous indiquez sur quelles feuilles elle doit s'appliquer. 2ème cas, vous excluez les feuilles sur lesquelles elle ne doit pas s'appliquer, exemples:

1er cas:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Sh.Name = "Feuil1" Or Sh.Name = "Feuil2" Then
        If Selection.Count = 1 And Target.Column >= 3 And Target.Column <= 15 Then
            Target.Formula = "=" & Target.Value & "/1.2"
        End If
    End If
Sortie:
    Application.EnableEvents = True
End Sub

2ème cas:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Sh.Name <> "Feuil3" And Sh.Name <> "Feuil4" Then
        If Selection.Count = 1 And Target.Column >= 3 And Target.Column <= 15 Then
            Target.Formula = "=" & Target.Value & "/1.2"
        End If
    End If
Sortie:
    Application.EnableEvents = True
End Sub

L'une de ces 2 macros est à copier dans le module "ThisWorkbook"

Cdlt

PS: Si ça vous convient, pensez à passer le sujet en "Résolu"

bonjour Melouille21, salut Arturo83,

n'est-ce pas nécessaire d'arrondir à 2 chiffres au centième ?

Bonjour Arturo83, BsAlv,

Je vous remercie pour vos réponses.

En effet, oui il faudrait arrondir à deux chiffres après la virgule si cela est possible ?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Sh.Name <> "Feuil3" And Sh.Name <> "Feuil4" Then
        If Selection.Count = 1 And Target.Column >= 3 And Target.Column <= 15 Then
            Target.Formula = "=" & Target.Value & "/1.2"
        End If
    End If
Sortie:
    Application.EnableEvents = True
End Sub

Dans la macro que vous m'avez transmis, la formule est appliqué à toutes les colonnes entre la 3ème et la 15ème si je comprends bien.

Cependant je souhaiterais qu'elle ne soit appliqué qu'aux colonnes 2,5,7 etc, comment je pourrais faire ?

Merci beaucoup pour vos réponses.

Comme ceci:

ligne suivante à compléter selon vos besoins dans le code qui suit:

     If Not Intersect(Target, Range("B:B,E:E,G:G")) Is Nothing Then

le code en entier

   Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Sh.Name <> "Feuil3" And Sh.Name <> "Feuil4" Then
        If Not Intersect(Target, Range("B:B,E:E,G:G")) Is Nothing Then
            If Selection.Count = 1 Then
                Target.Formula = "=" & Target.Value & "/1.2"
            End If
        End If
    End If
Sortie:
    Application.EnableEvents = True
End Sub
Rechercher des sujets similaires à "calcul automatique vba"