Affectation des résultats d'une macro

Bonjour à tous, je recherche un petit coup de main.
J ai une base de données de type assureur auto avec différents critères par colonne pour chaque profil (age, sexe, nombre d'années de permis ... )et je cherche à calculer la prime pour chaque client dans une nouvelle colonne mais le même résultat est donné pour chaque profil , je pense avoir un problème sur les boucles car en modifiant quelque peu la macro pour faire le calcul ligne par ligne ça fonctionne .....

voila mon code dans lequel pp est une prime pure :

Sub test()

Dim pp As Integer, coefPret As Double, coefSexe As Double, Bonus As Double, malus As Double, chevauxFisc As Integer, coefAge As Double
Dim p As Object, PrimeAnnuelle As Double, i As Integer, n As Integer


Set p = Range("c2:i1000")

pp = 200

For i = 1 To n

chevauxFisc = p.Cells(i, 4).Value * 30
Next

'boucle for pour les conditions sur les tranches d'age
For i = 1 To 49
If p.Cells(i, 1).Value >= 18 And p.Cells(i, 1).Value < 25 Then
coefAge = 1.7
Else
 If p.Cells(i, 1).Value >= 25 And p.Cells(i, 1).Value < 35 Then
 coefAge = 1.45
 Else
If p.Cells(i, 1) >= 35 Then
coefAge = 1.1
End If
     End If
           End If
Next

'boucle for sur le sexe
For i = 1 To 49
If p.Cells(i, 2).Value = "m" Then
coefSexe = 1.1
Else
 If p.Cells(i, 2).Value = "f" Then
 coefSexe = 1
 Else
 If p.Cells(i, 2).Value <> "m" And p.Cells(i, 2).Value <> "f" Then
 MsgBox ("La valeur rentrée ne correspond pas, entrez m ou f")
 End If
       End If
              End If
Next

'boucle for pour le deuxième conducteur
For i = 1 To 49
If p.Cells(i, 5).Value = "oui" Then
coefPret = 1.15
Else
 If p.Cells(i, 5).Value = "non" Then
 coefPret = 1
 Else
 If p.Cells(i, 5).Value <> "oui" And p.Cells(i, 5).Value <> "non" Then
 MsgBox (" la valeur rentrée n'est pas correcte")
End If
      End If
              End If
              Next

'boucle pour le bonus en fonction du nombre d'année de détention du permis

For i = 1 To 49
If p.Cells(i, 3).Value > 13 Then

Bonus = 0.5

Else

Bonus = 0.95 ^ p.Cells(i, 3).Value

End If
Next



'Boucle pour le calcul du malus
For i = 1 To 48

malus = 1.1 ^ p.Cells(i, 6).Value

Next
'calcul de la prime annuelle

For i = 1 To 49
p.Cells(i, 7) = (pp * coefPret * coefSexe * Bonus * malus * coefAge) + chevauxFisc
Next

End Sub


EDIT: Ajout de la coloration syntaxique.

2 réponses

  • Votes
  • Date
  • Date décroissante
  1. bonjour,

    je pense avoir un problème sur les boucles
    Ben oui, 49 fois le meme calcul a chaque boucle ca mene pas loin.
    la variable n n'est pas initialisee !!!!

    Faire chaque calcul dans une boucle de 1 a 49
    1. Bonsoir VBABeug, bonsoir le forum,

      Je verrais les choses comme ça, avec une seule boucle :

      Sub test()
      Dim pp As Integer
      Dim chevauxFisc As Byte
      Dim coefAge As Single
      Dim coefSexe As Single
      Dim coefPret As Single
      Dim Bonus As Single
      Dim malus As Single
      Dim i As Byte
      
      pp = 200
      For i = 1 To 49
          'boucle for pour les conditions sur les tranches d'age
          If p.Cells(i, 1).Value >= 18 And p.Cells(i, 1).Value < 25 Then
              coefAge = 1.7
          Else
              If p.Cells(i, 1).Value >= 25 And p.Cells(i, 1).Value < 35 Then
                  coefAge = 1.45
              Else
                  If p.Cells(i, 1) >= 35 Then
                      coefAge = 1.1
                  End If
              End If
          End If
          If p.Cells(i, 2).Value = "m" Then
              coefSexe = 1.1
          Else
              If p.Cells(i, 2).Value = "f" Then
                  coefSexe = 1
              Else
                  If p.Cells(i, 2).Value <> "m" And p.Cells(i, 2).Value <> "f" Then
                      MsgBox ("La valeur rentrée ne correspond pas, entrez m ou f")
                      Exit Sub
                  End If
              End If
          End If
          'boucle pour le bonus en fonction du nombre d'année de détention du permis
          If p.Cells(i, 3).Value > 13 Then
              Bonus = 0.5
          Else
              Bonus = 0.95 ^ p.Cells(i, 3).Value
          End If
          chevauxFisc = p.Cells(i, 4).Value * 30
          'boucle for pour le deuxième conducteur
          If p.Cells(i, 5).Value = "oui" Then
              coefPret = 1.15
          Else
              If p.Cells(i, 5).Value = "non" Then
                  coefPret = 1
              Else
                  If p.Cells(i, 5).Value <> "oui" And p.Cells(i, 5).Value <> "non" Then
                      MsgBox (" la valeur rentrée n'est pas correcte")
                      Exit Sub
                  End If
              End If
          End If
          'Boucle pour le calcul du malus
          malus = 1.1 ^ p.Cells(i, 6).Value
          'calcul de la prime annuelle
          p.Cells(i, 7) = (pp * coefPret * coefSexe * Bonus * malus * coefAge) + chevauxFisc
      Next i
      End Sub