Macro/VBA problème d'exécution

Bonjour,

Je vérifie actuellement une macro sous VBA qui ne fonctionne pas : la macro doit vérifier une somme d'écart tout en restant inférieure ou égale à 10. Le problème se situe dans le calcul : les virgules ne sont pas prises en compte. Autrement dit, la macro somme uniquement les valeurs entières et non les décimales ce qui conduit à une erreur.

Merci d'avance pour vos réponses.

Bonjour,

Sans voir le code difficile de dire.

Ma boule de cristal me signale tout de même qu'il s'agit peut être de la somme de variables déclarées As Integer.

Si c'est le cas, les déclarer As Single ou As Double devrait résoudre le problème.

Sinon revenir avec le code et des exemples de valeurs...

Bonjour et bienvenu(e)

Bonjour pijaku

Une vérification à faire

Tes variables ne doivent pas être de type Integer

Le fichier en cause ainsi que ta macro est indispensable

Merci pour vos réponses.

Voici le code :

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 Long

Dim B As Long

Dim C As Long

Dim D As Long

Dim E As Long

Dim ECARTAL As Long

Dim ECARTBL As Long

Dim ECARTCL As Long

Dim ECARTDL As Long

Dim ECARTEL As Long

Dim SOMMEECARTL As Long

Dim SOMMEECARTLinit As Long

Dim ECARTAD As Long

Dim ECARTBD As Long

Dim ECARTCD As Long

Dim ECARTDD As Long

Dim ECARTED As Long

Dim SOMMEECARTD As Long

Dim SOMMEECARTDinit As Long

Dim RESL As Long

Dim RESD As Long

Dim X As Integer

Dim Y As Integer

Dim I As Integer

Dim CELLDEP As Integer

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 -50 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 50 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

Sub calcul_L()

REFL125 = 67

REFL250 = 67

REFL500 = 65

REFL1000 = 62

REFL2000 = 49

SOMMEECARTL = 0

For X = 0 To 20

If X = Range("nbr_essais_impact").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 REFL125 > a Or REFL125 = a Then ECARTAL = 0

If REFL125 < a Then ECARTAL = a - REFL125

If REFL250 > B Or REFL250 = B Then ECARTBL = 0

If REFL250 < B Then ECARTBL = B - REFL250

If REFL500 > C Or REFL500 = C Then ECARTCL = 0

If REFL500 < C Then ECARTCL = C - REFL500

If REFL1000 > D Or REFL1000 = D Then ECARTDL = 0

If REFL1000 < D Then ECARTDL = D - REFL1000

If REFL2000 > E Or REFL2000 = E Then ECARTEL = 0

If REFL2000 < E Then ECARTEL = E - REFL2000

SOMMEECARTLinit = ECARTAL + ECARTBL + ECARTCL + ECARTDL + ECARTEL

If SOMMEECARTLinit < 10 Or SOMMEECARTLinit = 10 Then

For I = -1 To -50 Step -1

If REFL125 + I > a Or REFL125 = a Then ECARTAL = 0

If REFL125 + I < a Then ECARTAL = a - (REFL125 + I)

If REFL250 + I > B Or REFL250 = B Then ECARTBL = 0

If REFL250 + I < B Then ECARTBL = B - (REFL250 + I)

If REFL500 + I > C Or REFL500 = C Then ECARTCL = 0

If REFL500 + I < C Then ECARTCL = C - (REFL500 + I)

If REFL1000 + I > D Or REFL1000 = D Then ECARTDL = 0

If REFL1000 + I < D Then ECARTDL = D - (REFL1000 + I)

If REFL2000 + I > E Or REFL2000 = E Then ECARTEL = 0

If REFL2000 + I < E Then ECARTEL = E - (REFL2000 + I)

SOMMEECARTL = ECARTAL + ECARTBL + ECARTCL + ECARTDL + ECARTEL

If SOMMEECARTL > 10 Then

'Or SOMMEECARTL = 10

I = I + 1

Exit For

End If

Next I

End If

If SOMMEECARTLinit > 10 Then

For I = 0 To 50 Step 1

If REFL125 + I > a Or REFL125 = a Then ECARTAL = 0

If REFL125 + I < a Then ECARTAL = a - (REFL125 + I)

If REFL250 + I > B Or REFL250 = B Then ECARTBL = 0

If REFL250 + I < B Then ECARTBL = B - (REFL250 + I)

If REFL500 + I > C Or REFL500 = C Then ECARTCL = 0

If REFL500 + I < C Then ECARTCL = C - (REFL500 + I)

If REFL1000 + I > D Or REFL1000 = D Then ECARTDL = 0

If REFL1000 + I < D Then ECARTDL = D - (REFL1000 + I)

If REFL2000 + I > E Or REFL2000 = E Then ECARTEL = 0

If REFL2000 + I < E Then ECARTEL = E - (REFL2000 + I)

SOMMEECARTL = ECARTAL + ECARTBL + ECARTCL + ECARTDL + ECARTEL

If SOMMEECARTL < 10 Then

I = I - 1

Exit For

End If

Next I

End If

'If REFL125 < a Then ECARTAL = a - REFL125

RESL = REFL500 + I

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

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

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

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

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

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

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

Next X

End Sub

Qu'en pensez-vous ?

De même, la routine devrait s'arrêter quand la somme des écarts est =10 et j'ai un cas où ça ne marche pour la rubrique de calcul L ???

Je trouve pas l'erreur.

Bonsoir

Banzai64 a écrit :

Le fichier en cause ainsi que ta macro est indispensable

50% de bon

Allez encore un petit effort

Bonjour,

Ci-joint le fichier - Module 1.

Bonjour,

Ci-joint le fichier - Module 1

Presque.

On avance.

Ne reste plus qu'à le joindre ce fichier...

Fichier trop gros (800 k) !!!!!! comment faire ?

La ligne de code précédente ne suffit pas ?

Cette réponse devrait te suffire :

> les variables déclarées As Long ou As Integer représentent des nombres entiers.

Ainsi :

Dim Nombre As Long
Nombre = 33.12456
MsgBox Nombre

va afficher la valeur de Nombre : 33

> Les variables déclarées As Single ou As Double représentent des nombres décimaux.

Ainsi :

Dim Nombre As Double
Nombre = 33.12456
MsgBox Nombre

va afficher la valeur de Nombre : 33,12456

A partir de là, à toi de savoir comment déclarer toutes tes variables selon si elles représentent un entier ou un décimal :

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 Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim E As Long
Dim ECARTAL As Long
Dim ECARTBL As Long
Dim ECARTCL As Long
Dim ECARTDL As Long
Dim ECARTEL As Long
Dim SOMMEECARTL As Long
Dim SOMMEECARTLinit As Long
Dim ECARTAD As Long
Dim ECARTBD As Long
Dim ECARTCD As Long
Dim ECARTDD As Long
Dim ECARTED As Long
Dim SOMMEECARTD As Long
Dim SOMMEECARTDinit As Long
Dim RESL As Long
Dim RESD As Long
Dim X As Integer
Dim Y As Integer
Dim I As Integer
Dim CELLDEP As Integer

Merci de la réponse. Je vais essayer.

Autre difficulté sur la macro, la somme dite des écarts doit être inférieure ou égale à 10 et ça ne marche pas !

Sub calcul_L()

REFL125 = 67

REFL250 = 67

REFL500 = 65

REFL1000 = 62

REFL2000 = 49

SOMMEECARTL = 0

For X = 0 To 20

If X = Range("nbr_essais_impact").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 REFL125 > a Or REFL125 = a Then ECARTAL = 0

If REFL125 < a Then ECARTAL = a - REFL125

If REFL250 > B Or REFL250 = B Then ECARTBL = 0

If REFL250 < B Then ECARTBL = B - REFL250

If REFL500 > C Or REFL500 = C Then ECARTCL = 0

If REFL500 < C Then ECARTCL = C - REFL500

If REFL1000 > D Or REFL1000 = D Then ECARTDL = 0

If REFL1000 < D Then ECARTDL = D - REFL1000

If REFL2000 > E Or REFL2000 = E Then ECARTEL = 0

If REFL2000 < E Then ECARTEL = E - REFL2000

SOMMEECARTLinit = ECARTAL + ECARTBL + ECARTCL + ECARTDL + ECARTEL

If SOMMEECARTLinit < 10 Or SOMMEECARTLinit = 10 Then

For I = -1 To -50 Step -1

If REFL125 + I > a Or REFL125 = a Then ECARTAL = 0

If REFL125 + I < a Then ECARTAL = a - (REFL125 + I)

If REFL250 + I > B Or REFL250 = B Then ECARTBL = 0

If REFL250 + I < B Then ECARTBL = B - (REFL250 + I)

If REFL500 + I > C Or REFL500 = C Then ECARTCL = 0

If REFL500 + I < C Then ECARTCL = C - (REFL500 + I)

If REFL1000 + I > D Or REFL1000 = D Then ECARTDL = 0

If REFL1000 + I < D Then ECARTDL = D - (REFL1000 + I)

If REFL2000 + I > E Or REFL2000 = E Then ECARTEL = 0

If REFL2000 + I < E Then ECARTEL = E - (REFL2000 + I)

SOMMEECARTL = ECARTAL + ECARTBL + ECARTCL + ECARTDL + ECARTEL

If SOMMEECARTL > 10 Then

'Or SOMMEECARTL = 10

I = I + 1

Exit For

End If

Next I

End If

If SOMMEECARTLinit > 10 Then

For I = 0 To 50 Step 1

If REFL125 + I > a Or REFL125 = a Then ECARTAL = 0

If REFL125 + I < a Then ECARTAL = a - (REFL125 + I)

If REFL250 + I > B Or REFL250 = B Then ECARTBL = 0

If REFL250 + I < B Then ECARTBL = B - (REFL250 + I)

If REFL500 + I > C Or REFL500 = C Then ECARTCL = 0

If REFL500 + I < C Then ECARTCL = C - (REFL500 + I)

If REFL1000 + I > D Or REFL1000 = D Then ECARTDL = 0

If REFL1000 + I < D Then ECARTDL = D - (REFL1000 + I)

If REFL2000 + I > E Or REFL2000 = E Then ECARTEL = 0

If REFL2000 + I < E Then ECARTEL = E - (REFL2000 + I)

SOMMEECARTL = ECARTAL + ECARTBL + ECARTCL + ECARTDL + ECARTEL

If SOMMEECARTL < 10 Then

I = I - 1

Exit For

End If

Next I

End If

'If REFL125 < a Then ECARTAL = a - REFL125

RESL = REFL500 + I

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

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

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

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

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

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

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

Next X

End Sub