Macro/VBA problème d'exécution

Bonjour,

Je ne comprends pas pourquoi la macro s'effectue mal : on cherche un décalage pour lequel la somme est la plus grande possible sans dépasser 10. Or, je trouve un décalage de 11,2. Si on ne tient pas compte des décimales, ça marche mais si on en tient compte ça ne marche.

Pourtant, les variables sont déclarées en Double.

Help help.

Le code est ci-après :

Option Explicit

Dim REFL125 As Integer

Dim REFL250 As Integer

Dim REFL500 As Integer

Dim REFL1000 As Integer

Dim REFL2000 As Integer

Dim REFD125 As Integer

Dim REFD250 As Integer

Dim REFD500 As Integer

Dim REFD1000 As Integer

Dim REFD2000 As Integer

Dim a As Double

Dim B As Double

Dim C As Double

Dim D As Double

Dim E As Double

Dim ECARTAL As Double

Dim ECARTBL As Double

Dim ECARTCL As Double

Dim ECARTDL As Double

Dim ECARTEL As Double

Dim SOMMEECARTL As Double

Dim SOMMEECARTLinit As Double

Dim ECARTAD As Double

Dim ECARTBD As Double

Dim ECARTCD As Double

Dim ECARTDD As Double

Dim ECARTED As Double

Dim SOMMEECARTD As Double

Dim SOMMEECARTDinit As Double

Dim RESL As Double

Dim RESD As Double

Dim X As Integer

Dim Y As Integer

Dim I As Integer

Dim CELLDEP As Double

Dim feuille As String

Dim var As String

Sub calcul_D()

REFD125 = 36

REFD250 = 45

REFD500 = 52

REFD1000 = 55

REFD2000 = 56

SOMMEECARTD = 0

feuille = ActiveSheet.Name

If feuille = "Aériens" Then

var = "nbr_essais_int"

Else

If feuille = "Façade" Then

var = "nbr_essais_ext"

End If

End If

For X = 0 To 20

If X = Range(var).Value Then Exit For

CELLDEP = 10

a = Cells(CELLDEP + 4 + X * 14, 12).Value

B = Cells(CELLDEP + 5 + X * 14, 12).Value

C = Cells(CELLDEP + 6 + X * 14, 12).Value

D = Cells(CELLDEP + 7 + X * 14, 12).Value

E = Cells(CELLDEP + 8 + X * 14, 12).Value

If REFD125 < a Or REFD125 = a Then ECARTAD = 0

If REFD125 > a Then ECARTAD = REFD125 - a

If REFD250 < B Or REFD250 = B Then ECARTBD = 0

If REFD250 > B Then ECARTBD = REFD250 - B

If REFD500 < C Or REFD500 = C Then ECARTCD = 0

If REFD500 > C Then ECARTCD = REFD500 - C

If REFD1000 < D Or REFD1000 = D Then ECARTDD = 0

If REFD1000 > D Then ECARTDD = REFD1000 - D

If REFD2000 < E Or REFD2000 = E Then ECARTED = 0

If REFD2000 > E Then ECARTED = REFD2000 - E

SOMMEECARTDinit = ECARTAD + ECARTBD + ECARTCD + ECARTDD + ECARTED

If SOMMEECARTDinit > 10 Or SOMMEECARTDinit = 10 Then

For I = 0 To -70 Step -1

If REFD125 + I < a Or REFD125 = a Then ECARTAD = 0

If REFD125 + I > a Then ECARTAD = REFD125 + I - a

If REFD250 + I < B Or REFD250 = B Then ECARTBD = 0

If REFD250 + I > B Then ECARTBD = REFD250 + I - B

If REFD500 + I < C Or REFD500 = C Then ECARTCD = 0

If REFD500 + I > C Then ECARTCD = REFD500 + I - C

If REFD1000 + I < D Or REFD1000 = D Then ECARTDD = 0

If REFD1000 + I > D Then ECARTDD = REFD1000 + I - D

If REFD2000 + I < E Or REFD2000 = E Then ECARTED = 0

If REFD2000 + I > E Then ECARTED = REFD2000 + I - E

SOMMEECARTD = ECARTAD + ECARTBD + ECARTCD + ECARTDD + ECARTED

If SOMMEECARTD < 10 Then

I = I + 1

Exit For

End If

Next I

End If

If SOMMEECARTDinit < 10 Then

For I = 0 To 70 Step 1

If REFD125 + I < a Or REFD125 = a Then ECARTAD = 0

If REFD125 + I > a Then ECARTAD = REFD125 + I - a

If REFD250 + I < B Or REFD250 = B Then ECARTBD = 0

If REFD250 + I > B Then ECARTBD = REFD250 + I - B

If REFD500 + I < C Or REFD500 = C Then ECARTCD = 0

If REFD500 + I > C Then ECARTCD = REFD500 + I - C

If REFD1000 + I < D Or REFD1000 = D Then ECARTDD = 0

If REFD1000 + I > D Then ECARTDD = REFD1000 + I - D

If REFD2000 + I < E Or REFD2000 = E Then ECARTED = 0

If REFD2000 + I > E Then ECARTED = REFD2000 + I - E

SOMMEECARTD = ECARTAD + ECARTBD + ECARTCD + ECARTDD + ECARTED

If SOMMEECARTD > 10 Then

I = I - 1

Exit For

End If

Next I

End If

'I = I - 1

RESD = REFD500 + I

Cells(CELLDEP + 4 + X * 14, 37).Value = REFD125 + I

Cells(CELLDEP + 5 + X * 14, 37).Value = REFD250 + I

Cells(CELLDEP + 6 + X * 14, 37).Value = REFD500 + I

Cells(CELLDEP + 7 + X * 14, 37).Value = REFD1000 + I

Cells(CELLDEP + 8 + X * 14, 37).Value = REFD2000 + I

Cells(CELLDEP + 2 + X * 14, 14).Value = I

Cells(CELLDEP - 1 + X * 14, 14).Value = RESD

Next X

End Sub

Rechercher des sujets similaires à "macro vba probleme execution"