Arrondi dans formulaire de calcul

Bonjour, cela fait un moment que j'étais pas ici.

Si vous pouvez me dépanner :

Je fait des devis sur excel avec des macro VBA

Résultat souhaité : 38.00 x 20 = 760€

Les chiffres visibles sous forme de texte sont totalisé dans la 3e Colonne avec une fonction qu i semble bien fonctionner, par contre

il faudrait que je puisse arrondir à 2 chiffres après la virgule. Fonction TexteS2Val(B207) mais pas d'arrondi.

Si vous avez une solution?

Merci d'avance.
Eric

Bonjour,

Normalement on utilise round en VBA : https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/round-function
A implémenter dans votre code VBA comme nous n'avons ni le code, ni le fichier ...

Ergotamine

En fait je ne peut pas faire de somme chainée si je n'arrive à arrondir les TextesVal, le résultat souhaité mais avec les arrondi

Je ne peux pas envoyer le fichier en l'état, il me faut du temps pour faire un extrait

j'ai trouvé cette fonction mais je ne sais plus comment y accéder avec l'éditeur je l'ai en texte.

Function TexteS2Val(cValeur As Variant) As Variant
' Permet de ne pas passer dans le programme principal s'il y a moins de 256 caractères à traiter

Dim ncValeur As String
Dim NewVal As Variant
Dim nLen As Long
Dim i As Long
Dim cCar As String
Dim lSPC As Long

' Permet de ne rien renvoyer si null ou vide
If VarType(cValeur) = 1 Or cValeur = "" Then
TexteS2Val = ""
Exit Function
End If

ncValeur = ""
nLen = Len(cValeur)
lSPC = False

For i = 1 To nLen
cCar = Mid(cValeur, i, 1)
If cCar = "[" Or cCar = "]" Then lSPC = Not lSPC
' Remplace les points par des virgules
cCar = IIf(cCar = ",", ".", cCar)
' Permet de ne pas stocker ce qu'il y a dans les crochets
If (Not lSPC) And (cCar <> "[") And (cCar <> "]") Then ncValeur = ncValeur + cCar
Next

NewVal = Application.Evaluate("=" & ncValeur)
' Permet de renvoyer un message d'erreur
If VarType(NewVal) = 10 Then
TexteS2Val = "Erreur de saisie"
Exit Function
End If

TexteS2Val = NewVal

End Function

Bonsoir,

Je pense qu'un petit bout de code comme ça suffirait :

Function TexteS2Val(cValeur As Variant) As Variant
TexteS2Val = Round(Replace(cValeur, ".", ",") * 1, 3)
End Function

Exemple avec 38.0041 devient 38,004. Si on veut plus ou moins de décimale, on change le dernier argument ,3 > ,2 pour deux décimales etc

Ou par formule EXCEL avec la valeur a arrondir en A1 :

=ARRONDI(CNUM(SUBSTITUE(A1;".";","));3)

Ergotamine

Merci, J'ai mis le code ici :

les arrondis fonctionnent mais je ne peut plus faire d'opération dans la ligne.

Bonjour,

Après rerererelecture j'ai enfin compris le problème. Vous avez des opérations texte en vert en colonne 2 (et non 3), vous souhaitez une formule pour les transformer en résultat de l'opération en colonne 3, arrondi a deux décimales, tout en pouvant en faire la somme C270 a C278 étant votre plage de cellule orange.

Dans ce cas :

Function TEXT2VAL(REF As String) As Variant
If REF = "" Then
    TEXT = ""
    Else
    CVAL = Application.Evaluate("=" & Replace(REF, ",", ".")) 'Evaluate ne fonctionne qu'avec des décimales sous forme de point
    TEXT2VAL = Round(CVAL, 2) 'On arrondi a deux décimales
End If
End Function

A noter que j'ai changé la référence de la fonction vers TEXT2VAL pour bien distinguer de la première.

Cf fichier joint.

Ergotamine.

Bonjour à tous,

Quelque chose de beaucoup plus simple qu'une fonction VBA

La fonction EVALUER() qui existait sous d'anciennes version d'Excel,
peut toujours être utilisée mais avec une astuce

1) Définir un nom, genre "Eval" qui fait référence à la formule

=EVALUER(Feuil1!$B2)

Si "Feuil1" est le nom de la feuille et B2 la première cellule qui contient la formule texte

2) dans C2, mettre la formule

=Eval

Et voilà le tour est joué

A+

Super,

La fonction Text2Val devrait convenir, et m'évite de tout re-écrire. Si j'ai bien compris, la fonction initiale à été simplifiée.
D'autre part la fonction EVAL peut toujours servir.

Pour l'instant je doit avancer dans mon travail, je ferais la mise à jour des arrondis dès que tout est bouclé. Je suis
"scotché" par l'efficacité des intervenants.
Je me suis mis au VBA depuis peu par nécessité en auto formation. Prochainement, dès que c'est possible, je soutiendrais financièrement ce site.

Rémy,

En vous remerciant de m'avoir dépanné

Bonsoir,

Si tu veux pas tout réécrire remplace le code de ta fonction dans ton fichier par :

Function TexteS2Val(REF As String) As Variant
If REF = "" Then
    TEXT = ""
    Else
    CVAL = Application.Evaluate("=" & Replace(REF, ",", ".")) 'Evaluate ne fonctionne qu'avec des décimales sous forme de point
    TexteS2Val = Round(CVAL, 2) 'On arrondi a deux décimales
End If
End Function

Ou sinon solution de Bruno que je salue et remercie, je ne la connaissais pas, peut être trop jeune

Ergotamine

Re,

Ci joint ma fonction mais cela ne "fonctionne pas" => fichier en pièce jointe

Function TexteS2Val(cValeur As Variant) As Variant
' Permet de ne pas passer dans le programme principal s'il y a moins de 256 caractères à traite



If REF = "" Then
TEXT = ""
Else
CVAL = Application.Evaluate("=" & Replace(REF, ",", ".")) 'Evaluate ne fonctionne qu'avec des décimales sous forme de point
TexteS2Val = Round(CVAL, 2) 'On arrondi a deux décimales
End If


End Function

Meerci

Bonjour,

Deux formules ne peuvent avoir le même nom dans un code de feuille. Vous aviez deux fonctions TextS2Val, ce n'est pas possible.

La feuille avec l'ancienne fonction supprimée, et la nouvelle modifiée.

Ergotamine

Donc si j'ai bien compris, sur mes documents existant il faudra que je fasse un recherche remplacer avec la nouvelle formule =Text2Val pour la mise jour arrondi?

Bonjour,

Sur votre fichier ALT+F11 > Vous allez dans votre Feuil1 > Vous remplacez votre ancienne fonction TexteS2Val par celle ci > Peut être sur votre feuille un MAJ+F9 :

Function TexteS2Val(REF As Variant) As Variant
If REF = "" Then
    TEXT = ""
    Else
    CVAL = Application.Evaluate("=" & Replace(REF, ",", ".")) 'Evaluate ne fonctionne qu'avec des décimales sous forme de point
    TexteS2Val = Round(CVAL, 2) 'On arrondi a deux décimales
End If
End Function

Ergotamine

Je verrais le moment venu, je vais surement devoir vous déranger.

Merci pour vos retours pertinents.