Simplification code vba formule avec 8 critères

[slaurent01]

bonsoir à tous,

Je suis débutant en programmation vba et j'essaie de creer un programme de devis. J'ai le code suivant qui sert à déterminer un temps de calage en fonction d'un nombre de couleurs. Le code fonctionne mais je souhaiterai savoir s'il existe une méthode plus efficace et surtout plus rapide pour l'écrire.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'selon le nombre de couleurs saisies en b1, on va déterminer un temps de calage

If Range("b1") = 0 Then
Range("a4").Value = 30
Else
If Range("b1") = 1 Then
Range("a4").Value = 30
Else
If Range("b1") = 2 Then
Range("a4").Value = 45
Else
If Range("b1") = 3 Then
Range("a4").Value = 60
Else
If Range("b1") = 4 Then
Range("a4").Value = 75
Else
If Range("b1") = 5 Then
Range("a4").Value = 75
Else
If Range("b1") = 6 Then
Range("a4").Value = 105
Else
If Range("b1") = 7 Then
Range("a4").Value = 120
Else
If Range("b1") = 8 Then
Range("a4").Value = 135
Else
If Range("b1") > 8 Then
 MsgBox ("Vous devez saisir un nombre de couleurs compris entre 0 et 8")
 
 
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If


End Sub

Par avance je vous remercie

Cordialement
stéphane

 

[Papou-net]

Re : Simplification code vba formule avec 8 critères

Bonsoir stephane,

Je te propose un peu plus court et plus structuré:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'selon le nombre de couleurs saisies en b1, on va déterminer un temps de calage
Select Case Range("B1").Value
  Case Is < 2
    Range("a4").Value = 30
  Case 2
    Range("a4").Value = 45
  Case 3
    Range("a4").Value = 60
  Case 4, 5
    Range("a4").Value = 75
  Case 6
    Range("a4").Value = 105
  Case 7
    Range("a4").Value = 120
  Case 8
    Range("a4").Value = 135
  Case Else
    MsgBox ("Vous devez saisir un nombre de couleurs compris entre 0 et 8")
End Select
End Sub

Cordialement.

 

[slaurent01]

Re : Simplification code vba formule avec 8 critères

bonsoir le forum,

bonsoir papou-net, merci pour votre réponse. C'est largement mieux que mon code.
J'aimerai bien acquérir cette logique pour structurer un code efficacement.

Merci pour votre aide, bonne soiree

Cordialement
stéphane

 

[Papou-net]

Re : Simplification code vba formule avec 8 critères

RE :

Encore plus court (avec utilisation d'un tableau), donc plus rapide également :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'selon le nombre de couleurs saisies en b1, on va déterminer un temps de calage
Coul = Array(30, 30, 45, 60, 75, 75, 105, 120, 135)
If Range("B1").Value <= 8 Then
  Range("A4").Value = Coul(Range("B1").Value)
  Else
  MsgBox ("Vous devez saisir un nombre de couleurs compris entre 0 et 8")
End If
End Sub

Cordialement.

 

[slaurent01]

Re : Simplification code vba formule avec 8 critères

re,

Merci, c'est encore mieux, autant le premier code je comprenais la structure, mais celui je ne comprends pas le shéma. Ca serait abuser de vous demander de m'expliquer ? (pour enrichir mes débuts de connaissances en vba)

Cordialement
stephane

 

[slaurent01]

Re : Simplification code vba formule avec 8 critères

re,

je fais appel de nouveau à votre aide car je n'arrive pas à écrire le code pour ma deuxième formule en vba.
Cette fois j'ai trois conditions :

Comme pour le premier calcul : condition de la couleur, puis du code tarif, et enfin si le résultat est inférieur à 15, indiquer 15.

J'ai voulu reprendre le même code que précedemment, le calcul se fait bien pour la premiere condition mais pas la suivante

  If Range("b2").Value = 1 Then
  Coul = Array(Range("g2") / 45, Range("g2") / 40, Range("g2") / 37.5, Range("g2") / 35, Range("g2") / 32.5, Range("g2") / 30, Range("g2") / 27.5, Range("g2") / 25, Range("g2") / 22.5)
 If Range("B1").Value <= 8 Then
   Range("b4").Value = Coul(Range("B1").Value)
   Else

   If Range("b2").Value = 2 Then
  Coul = Array(Range("g2") / 58, Range("g2") / 58, Range("g2") / 55, Range("g2") / 51, Range("g2") / 48, Range("g2") / 45, Range("g2") / 41, Range("g2") / 38, Range("g2") / 35)
 If Range("B1").Value <= 8 Then
   Range("b4").Value = Coul(Range("B1").Value)
   
 If Range("b4").Value < 15 Then
 Range("b4").Value = 15
 End If
 End If
 End If
 End If
 
 End Sub

Pourriez vous me dire, svp comment je dois procéder pour écrire ce code.

Cordialement
stéphane

 

[Papou-net]

Re : Simplification code vba formule avec 8 critères

re,

Merci, c'est encore mieux, autant le premier code je comprenais la structure, mais celui je ne comprends pas le shéma. Ca serait abuser de vous demander de m'expliquer ? (pour enrichir mes débuts de connaissances en vba)

Cordialement
stephane

RE :

Alors voilà les explications :

Je définis une variable Coul sous forme de tableau Array.
Ce tableau contient 9 valeurs qui vont de l'indice 0 à 8. Les tableaux commençant à 0, ceci est l'explication de cela : 8 est donc stocké à l'indice 9.
Puis j'écris la condition suivante : si B1 est inférieur ou égal à 8 alors la cellule A4 prend la valeur de Coul stockée sous l'indice de B1. Voici pourquoi il y a plusieurs valeurs de Coul identiques dans le tableau.Par exemple, si B1 est vide ou=0 c'est l'indice 0 (30) qui est écrit en A4. Si B1=1 c'est l'indice 1 (30), si B1=2 c'est l'indice 2 (45) et ainsi de suite...

Pour schématiser :

Ind Valeur
0 --> 30
1 --> 30
2 --> 45
3 --> 60
4 --> 75
5 --> 75
6 --> 105
7 --> 120
8 --> 135

Si B1>8 alors c'est le message qui s'affiche.

Ce n'est pas plus compliqué que cela, la seule astuce réside dans la définition du tableau pour éviter les conditions en série. Une seule ligne d'affectation suffit.

Espérant avoir répondu.

Cordialement.

 

[Papou-net]

Re : Simplification code vba formule avec 8 critères

je fais appel de nouveau à votre aide car je n'arrive pas à écrire le code pour ma deuxième formule en vba.

RE :

Nul besoin de réécrire de nouvelles conditions, il suffit de créer un Array (que j'ai nommé TempRoul) selon le même principe que précédemment. Puis ajouter une ligne d'affectation du calcul à la cellule B4, ce qui donne :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ind As Byte, Lpc As Long, Tpsr As Double, Coul, TempRoul
Coul = Array(30, 30, 45, 60, 75, 90, 105, 120, 135)
TempRoul = Array(45, 40, 37.5, 35, 32.5, 30, 27.5, 25, 22.2)
Ind = Range("B1")
Lpc = Range("G2")
 
If Ind <= 8 Then
  'selon le nombre de couleurs saisies en b1, on va déterminer un temps de calage
  Range("A4") = Coul(Ind)
  'selon le nombre de couleurs saisies en b1 et le code du tarif saisie en b2 on va
  'déterminer un temps de roulage
  Tpsr = TempRoul(Ind)
  Range("B4") = Application.Max(Lpc / TempRoul(Ind), 15)
  Else
  MsgBox ("Vous devez saisir un nombre de couleurs compris entre 0 et 8"), vbCritical
End If
End Sub

Pour faciliter la compréhension du code, j'ai créé de nouvelles variables ce qui a pour effet d'en améliorer la lisibilité.

Je te joins le fichier ainsi modifié pour tester à volonté.

Cordialement.

 

[slaurent01]

Re : Simplification code vba formule avec 8 critères

bonjour le forum,

bonjour papou-net

Merci de m'avoir répondu , en me donnant toutes ses explications que je vais étudier attentivement.

toutefois en ce qui concerne la variable TempRoul il y deux conditions :
si tarif 1

TempRoul = Array(45, 40, 37.5, 35, 32.5, 30, 27.5, 25, 22.2)

si tarif 2
il faudrait insérer cette deuxieme condition, mais je sèche....

TempRoul = Array(58, 58, 55, 51, 48 , 45, 38, 35

Cordialement
stephane

 

[Papou-net]

Re : Simplification code vba formule avec 8 critères

Bonjour Stéphane,

Voici ton fichier corrigé.

J'ai ajouté les 3 lignes de condition If Tarif = ...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ind As Byte, Lpc As Long, Tarif As Byte, Tpsr As Double, Coul, TempRoul
Coul = Array(30, 30, 45, 60, 75, 90, 105, 120, 135)
Tarif = Range("B2")
' Si Tarif=0 ou Tarif>2 alors effacement de B2 et fin de la macro
If Tarif = 0 Or Tarif > 2 Then Range("B2") = "": Exit Sub
If Tarif = 1 Then TempRoul = Array(45, 40, 37.5, 35, 32.5, 30, 27.5, 25, 22.2)
If Tarif = 2 Then TempRoul = Array(58, 58, 55, 51, 48, 45, 38, 35, 32)
Ind = Range("B1")
Lpc = Range("G2")
 
If Ind <= 8 Then
  'selon le nombre de couleurs saisies en b1, on va déterminer un temps de calage
  Range("A4") = Coul(Ind)
  'selon le nombre de couleurs saisies en b1 et le code du tarif saisie en b2 on va
  'déterminer un temps de roulage
  Tpsr = TempRoul(Ind)
  Range("B4") = Application.Max(Lpc / TempRoul(Ind), 15)
  Else
  MsgBox ("Vous devez saisir un nombre de couleurs compris entre 0 et 8"), vbCritical
End If
End Sub

Sur la condition Tarif = 2, comme il manquait une valeur j'ai ajouté 32 en fin de liste.

Bonne journée.

Cordialement.

 

[slaurent01]

Re : Simplification code vba formule avec 8 critères

re

un grand merci papou-net, ca fonctionne parfaitement bien.
Je vais pouvoir continuer ainsi mon appli.
Cordialement
Stéphane