Arrondi non désiré excel/VBA

Bonjour,

Voici ma problématique. Lorsque je lance mes calculs en vba excel ne travail qu'avec des nombres arrondies alors que je désire avoir le resultat exact.

J'ai cherché dans mon code ou s'il y avait un mauvais paramétrage excel mais je ne trouve pas.

Pouvez vous m'aider ?

ci dessous le code + le fichier.

Merci d'avance

11book2.xlsm (68.32 Ko)
Sub allll()

Call Spread
Call viaHaut
Call viabas

End Sub

Sub Spread()

j = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row

For a = j To 1 Step -1

If a <> 1 Then
If (Cells(a, 1) <> Cells(a - 1, 1)) And (Cells(a, 5) = Cells(a - 1, 5)) Then

FUT = Left(Cells(a, 1), 2)

    If FUT = "VG" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "Z " Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "GX" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "EO" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "CF" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "CM" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "SM" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    End If

If X < Y Then
Cells(a, 10) = Cells(a, 4).Value - Cells(a - 1, 4)
Cells(a, 8) = Cells(a, 5)

ElseIf X > Y Then

Cells(a - 1, 10) = Cells(a - 1, 4) - Cells(a, 4)
Cells(a - 1, 8) = Cells(a - 1, 5)

End If

End If

End If

Next

End Sub

Sub viaHaut()

Dim ZA As Double
Dim ZB As Double
Dim ZC As Double

j = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row

For a = j To 1 Step -1

If a <> 1 Then

If (Cells(a, 1) <> Cells(a + 1, 1)) Then

    FUT = Left(Cells(a, 1), 2)

    If FUT = "VG" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a + 1, 1), 2)

    ElseIf FUT = "Z " Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a + 1, 1), 2)

    ElseIf FUT = "GX" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a + 1, 1), 2)

    ElseIf FUT = "EO" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a + 1, 1), 2)

    ElseIf FUT = "CF" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a + 1, 1), 2)

    ElseIf FUT = "CM" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a + 1, 1), 2)

    ElseIf FUT = "SM" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a + 1, 1), 2)

    End If

    If (Cells(a, 5) <> Cells(a + 1, 5)) Then

        If ((Cells(a, 5) = Cells(a + 1, 5) + Cells(a + 2, 5)) And (Cells(a + 1, 1) = Cells(a + 2, 1))) Then

        ZA = Cells(a + 1, 5) * Cells(a + 1, 4) + Cells(a + 2, 5) * Cells(a + 1, 4)

        ZB = Cells(a + 1, 5) + Cells(a + 2, 5)

        ZC = Round(ZA / ZB, 4)
        Cells(a, 9) = ZC

        Cells(a, 8) = Cells(a, 5)

        If X < Y Then
        Cells(a, 10) = Cells(a, 4) - Cells(a, 9)

        ElseIf X > Y Then
        Cells(a, 10) = Cells(a, 9) - Cells(a, 4)

        End If

        End If

    End If

End If

End If

Next

End Sub

Sub viabas()

j = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row

For a = j To 1 Step -1

If (a <> 1 And a <> 2) Then

If (Cells(a, 1) <> Cells(a - 1, 1)) Then

 FUT = Left(Cells(a, 1), 2)

    If FUT = "VG" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "Z " Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "GX" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "EO" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "CF" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "CM" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    ElseIf FUT = "SM" Then

    X = Right(Cells(a, 1), 2)
    Y = Right(Cells(a - 1, 1), 2)

    End If

    If (Cells(a, 5) <> Cells(a + 1, 5)) Then

        If a > 3 Then

        If (Cells(a, 5) = Cells(a - 1, 5) + Cells(a - 2, 5) And Cells(a - 1, 1) = Cells(a - 2, 1)) Then
        Cells(a, 9) = (Cells(a - 1, 5) * Cells(a - 1, 4) + Cells(a - 2, 5) * Cells(a - 1, 4)) / (Cells(a - 1, 5) + Cells(a - 2, 5))
        Cells(a, 8) = Cells(a, 5)

        If X < Y Then
        Cells(a, 10) = Cells(a, 4) - Cells(a, 9)

        ElseIf X > Y Then
        Cells(a, 10) = Cells(a, 9) - Cells(a, 4)

        End If

        End If

       End If

    End If

End If

End If

Next

End Sub

Bonjour

Je ne vois pas où est le problème : la différence entre 2 nombres entiers ne peut être qu'un nombre entier.

Bye !

merci de votre retour

Par ex cette partie ci dessous est une moyenne donc pas enctière.

If ((Cells(a, 5) = Cells(a + 1, 5) + Cells(a + 2, 5)) And (Cells(a + 1, 1) = Cells(a + 2, 1))) Then

        ZA = Cells(a + 1, 5) * Cells(a + 1, 4) + Cells(a + 2, 5) * Cells(a + 1, 4)

        ZB = Cells(a + 1, 5) + Cells(a + 2, 5)

        ZC = Round(ZA / ZB, 4)
        Cells(a, 9) = ZC

        Cells(a, 8) = Cells(a, 5)

merci d'avance

cette partie ci dessous est une moyenne donc pas enctière.

Pas forcément.

Si ZA est un multiple de ZB, le résultat de ZA/ZB sera un entier

Bye !

Rechercher des sujets similaires à "arrondi desire vba"