petit problème de fractions

[Roland_M]

bien bonjour à tous,
j'ai ce petit problème de fraction à vous soumettre car je ne suis pas certain de bien m'y prendre !?

les données de départ sont les suivante: un numérateur, un dénominateur et un multiplicateur !
exemple: 40/27 avec un multiplicateur de 1,04 (soit 4%)
avec ce multiplicateur je dois retrouver la fraction qui correspond après application du multiplicateur
ValeurRecherchée= (Numerateur / Denominateur) * Multiplicateur ! Soit (40/27)*1,04=1,5407407...
QUESTION : comment trouver la fraction correspondant à cette valeur !?

personnellement je pratique ainsi (en simplifiant !)

For X=1 to 100: For Y=1 to 100: V = X / Y
If V = ValeurRecherchee Then  Ok la fraction est="X/Y"
...

si pas de fraction trouvée, j'inclus une tolérance exemple PasTolerance=0,001

Tolerance = 0
Do
  Tolerance = Tolerance + PasTolerance
  ValFindMoins = ValeurRecherchee - Tolerance
  ValFindPlus = ValeurRecherchee + Tolerance
  For X = 1 To 100:  For Y = 1 To 100: V = X/Y
  If V <> ValeurRecherchee And (V >= ValFindMoins And V <= ValFindPlus) Then
      "ValeurProche = V"
      "ToleranceProche= Tolerance"
      "FractionProche= X/Y"
...

j'aimerai savoir si c'est correcte et surtout si vous avez mieux !?
un grand merci d'avance !

 

[ROGER2327]

Re : petit problème de fractions

Bonjour Roland_M

En ne voyant que des petits morceaux de code, il n'est pas facile de se faire une opinion.
Voici un code pour trouver la fraction réduite équivalente au produit (a/b)*(p*q) :

[COLOR="DarkSlateGray"][B]Function prodfrac(p As Long, q As Long, a As Long, b As Long)
Dim u
   Application.Volatile
   u = pgcd(a, b)
   a = a / u
   b = b / u
   u = pgcd(p, q)
   p = p / u
   q = q / u
   u = pgcd(a * p, b * q)
   prodfrac = a * p / u & "/" & b * q / u
End Function

Function pgcd(ByVal a As Long, ByVal b As Long)
Dim d As Long
    a = Abs(a): b = Abs(b)
    Do While b > 0
        d = a - (a \ b) * b: a = b: b = d
    Loop
    pgcd = a
End Function[/B][/COLOR]

Dans le cas de votre exemple (40/27)*(104/100), =prodfrac(40;27;104;100) renvoie 208/135.​

ROGER2327
#2274

 

[Roland_M]

Re : petit problème de fractions

re:

je ne sais pas pourquoi, mais je savais que ROGER2327 se manifesterait !?
merci à toi ! 😉

en fait c'est pour mon fils qui travaille en verrerie
c'est pour une utilisation très particulière et ce serait un peu pénible pour moi d'expliquer ça ici !
ce sont des corrections à apporter à des automates d'où il y a une petite erreur de syncro pour le débit des flacons !?

on part d'une fraction connue mais pour être syncro il faut ajouter 1,0415%
et rechercher la fraction qui correspond après cette correction !
je ne suis pas matheux et il faut bien se débrouiller !
ci-joint le classeur (c'est un code que j'ai séparé d'un programme)
il y a simplement un module avec un Sub !

 

[pierrejean]

Re : petit problème de fractions

Bonjour Roland M

Salut ROGER

J'etais moi aussi parti sur le PGCD mais je ne suis arrivé a rien
Je propose ceci qui a l'air de fonctionner

Sub test()
Range("F4:H4").ClearContents
diff = 100
valeur = Range("A2") / Range("B2") * Range("C2")
For n = 1 To 100
 For m = 1 To 100
   x = n / m
   z = Abs(x - valeur)
   If z < diff Then
     a = n
     b = m
     diff = z
   End If
 Next m
Next n
Range("F4") = a / b
Range("G4") = CStr(a) & "/" & CStr(b)
Range("H4") = valeur - a / b
End Sub

 

[Roland_M]

Re : petit problème de fractions

re:

un grand merci à toi aussi PierreJean !
effectivement ce n'est pas trop une affaire de PGCD !

encore merci à vous deux !

 

[ROGER2327]

Re : petit problème de fractions

Bonsoir à tous

Je ne suis pas certain d'avoir compris, mais comme j'y ai passé du temps, je livre deux versions. La deuxième utilise le p.g.c.d. pour calculer la fraction résultante exacte. Il faut toutefois que les nombres en jeu ne soient pas trop grands pour éviter les erreurs d'arrondi.​

ROGER2327
#2276

 

[Roland_M]

Re : petit problème de fractions

re:

Excellent ! merci ROGER pour le temp passé !

 

[pierrejean]

Re : petit problème de fractions

Re

Super ROGER
J'ai encore appris quelque chose