Formule personnelle VBA - Tests

[Nikless]

Bonsoir le forum,

Mon objectif est de simplifier une formule longue à rédiger et source de fautes de saisie.
Je butte sur un problème de formule VBA pour laquelle j'utilise des tests avec l'instruction Select.Case

Je souhaiterais également que cette formule se calcule lors de chaque modification de manière dynamique.

Vous trouverez dans le fichier joint un modèle de ce que je cherche à faire avec mon esquisse de code VBA.

Merci d'avance pour votre aide,

Nicolas

 

[PMO2]

Re : Formule personnelle VBA - Tests

Bonjour,

Essayez avec ces modifications

Function FThrough(CA1 As Range, CA2 As Range, R1 As Range, R2 As Range) As Double
Dim dCA As Double
Dim dRBE As Double

A = CA1.Value
B = CA2.Value
C = R1.Value
D = R2.Value


dCA = B - A
dRBE = D - C

Select Case dCA
Case Is > 0
FThrough = dRBE / dCA

Case Is > dRBE
FThrough = (dRBE - dCA / -dCA) - 1

Case Is < 0
FThrough = (dCA - dRBE) / dCA

Case Else
FThrough = (dRBE - dCA) / -dCA
End Select

End Function

 

[Nikless]

Re : Formule personnelle VBA - Tests

Bonjour PMD2, bonjour le fil, bonjour le forum,

Cela fonctionne correctement et renvoie le résultat souhaité.
Existe-t'il des bonnes pratiques pour optimiser le code de cette fonction ?

A vous,
N.

 

[PMO2]

Re : Formule personnelle VBA - Tests

Bonjour,

Existe-t'il des bonnes pratiques pour optimiser le code de cette fonction ?

Il existe une manière de faire pour faciliter l'usage de la fonction auprès des utilisateurs.
1) Mettre des arguments de fonction qui soient plus explicites
2) Ajouter un descriptif de la fonction

Code dans un module standard

Function FThrough(Chiffre_Affaires_1 As Range, Chiffre_Affaires_2 As Range, RBE1 As Range, RBE2 As Range) As Double
Dim dCA As Double
Dim dRBE As Double
'---
dCA = Chiffre_Affaires_2 - Chiffre_Affaires_1
dRBE = RBE2 - RBE1
Select Case dCA
  Case Is > 0
    FThrough = dRBE / dCA
  Case Is > dRBE
    FThrough = (dRBE - dCA / -dCA) - 1
  Case Is < 0
    FThrough = (dCA - dRBE) / dCA
  Case Else
    FThrough = (dRBE - dCA) / -dCA
End Select
End Function

Sub DescriptionFThrough(Optional dummy As Byte)
Application.MacroOptions Macro:="FThrough", Category:=14, _
Description:="la fonction FThrough :" _
            & vbCrLf & "elle fait ceci" _
            & vbCrLf & "et aussi cela" _
            & vbCrLf & "et encore ..." _
            & vbCrLf & "Bon courage."
End Sub

Code dans la fenêtre de code de ThisWorkbook

Private Sub Workbook_Open()
Call DescriptionFThrough
End Sub

 

[Nikless]

Re : Formule personnelle VBA - Tests

A nouveau, merci pour ces conseils.

 

[Nikless]

Re : Formule personnelle VBA - Tests

Bonsoir le forum,
Je viens à nouveau solliciter votre aide pour m'aider à traiter deux scenarii que je ne parviens pas à intégrer dans mon Case Select. En effet, je voudrais utiliser des conditions multiples de type AND mais cela ne semble pas possible.

Merci d'avance pour votre aide,
Cordialement,
N.

 

[Nikless]

Re : Formule personnelle VBA - Tests

Bonsoir,
J'ai expérimenté en revoyant le code avec la méthode If Then... Else mais rien de bien concluant malgré 2 tentatives différentes.
Je serai curieux d'avoir votre avis sur la question.

J'ai indiqué dans la PJ les scenarii ne renvoyant pas le bon résultat.

 

[PMO2]

Re : Formule personnelle VBA - Tests

Bonjour,

Essayez avec le code modifié de la fonction

Function FlowThrough(Chiffre_Affaires_1 As Range, Chiffre_Affaires_2 As Range, RBE1 As Range, RBE2 As Range) As Double
Dim dCA As Double
Dim dRBE As Double
'---
dCA = Chiffre_Affaires_2 - Chiffre_Affaires_1
dRBE = RBE2 - RBE1
Select Case dCA
  Case Is > 0
    If dRBE > dCA Then FlowThrough = dRBE / dCA                       'cas 1
    If dCA > dRBE And dRBE > 0 Then FlowThrough = dRBE / dCA          'cas 2
    If dRBE < 0 Then FlowThrough = dRBE / dCA - 1                     'cas 3
  Case Is < 0
    If dRBE > 0 Then FlowThrough = (dRBE - dCA) / -dCA                'cas 4
    If 0 > dRBE And dRBE > dCA Then FlowThrough = (dCA - dRBE) / dCA  'cas 5
    If 0 > dCA And dCA > dRBE Then FlowThrough = (dRBE - dCA) / -dCA  'cas 6
End Select
End Function
'''Cas 1  Var CA > 0   Var RBE > Var CA > 0    =B/A
'''Cas 2  Var CA > 0   Var CA > Var RBE> 0   =B/A
'''Cas 3  Var CA > 0   Var CA > 0 > Var RBE    =B/A-1
'''Cas 4  Var CA < 0   Var RBE >0 > Var CA   =(B-A)/-A
'''Cas 5  Var CA < 0   0 > Var RBE > Var CA    =(A-B)/A
'''Cas 6  Var CA < 0   0 > Var CA > Var RBE    =((B-A)/-A)

 

[Nikless]

Re : Formule personnelle VBA - Tests

Merci cela fonctionne tout à fait selon mes attentes. 6 sur 6 !
Bonne soirée.