Bonjour
 
Je suis sur un calcul itératif de plusieurs équations à plusieurs inconnues.
 
Afin de permettre la résolution de ce système le plus rapidement possible je suis passer par deux boucles d'itérations afin d'approcher le calcul à "taton" avec toutefois une très bonne précision de calcul.
 
Le problème c'est de faire que le calcul s'éxecute le plus rapidement possible car il faut que à terme il soit capable d'effectuer se calcul plus de 1500 fois par seconde.
 
Voici donc le code est dite moi si il y a moyen d'améliorer grandement la vitesse de calcul.
 
Je pense que oui quand même mais n'étant pas très fort en vba    
 
Private Sub Worksheet_selectionchange(ByVal Target As Range)
Dim uo, u, ttamont, co, j, d, t, iteration, c
Dim d1, d2, rey, tmdiaph, coef1, ra, rv
Dim rho, ptamont, s, gamma, epsi, beta, cortemp
Dim cpv, cpa, uvo, uv, ua, uao, rp, xv, r, cp
Dim aleatoire
Dim dpdiaph, e, q, pi, mach, a, vitis
 
pi = 3.141592654
uo = 0.0000182
r = 287.04
d11 = Cells(5, 5).Value / 1000 'diamètre du diaphragme
d22 = Cells(3, 5).Value / 1000 'diamètre de la veine
coefdil = 0.0000175
i = 7 'premier point
Do
    i = i + 1
    If Cells(i, 2).Value = "" Or Cells(i, 3).Value = "" Or Cells(i, 4).Value = "" Or Cells(i, 5).Value = "" Then Exit Do
    co = 0.6
    ttamont = Cells(i, 5).Value
    tmdiaph = Cells(i, 4).Value
    ptamont = Cells(i, 3).Value * 1000
    dpdiaph = Cells(i, 2).Value * 1000
    t0 = ttamont
    d2 = d22 * (1 + coefdil * (tmdiaph - 288.15))
    d1 = d11 * (1 + coefdil * (tmdiaph - 288.15))
    beta = d11 / d22 ' rapport de d1 sur d2
     
    If beta <= 0.1 Or beta >= 0.75 Then
        Cells(i, 6).Value = "Beta hors tolérance"
        Exit Do
    End If
         
    If (4 * dpdiaph) > ptamont Then
        Cells(i, 6).Value = "DeltaP/P>0.25"
        Exit Do
    End If
         
    If tmdiaph <= 0 Or ptamont <= 0 Or ttamont <= 0 Then Exit Do
    If dpdiaph <= 0 Then dpdiaph = 10 ^ -6
    Do
        rho = ptamont / (r * t0)
        s = (pi * d1 ^ 2) / 4
        cp = r * (3.5 - 2.8 * (10 ^ -5) * t0 + 2.24 * (10 ^ -8) * (t0 ^ 2) + (3090 / t0) ^ 2 * ((Exp(3090 / t0))) / ((Exp(3090 / t0) - 1) ^ 2))
        gamma = cp / (cp - r)
        epsi = 1 - (0.351 + 0.256 * beta ^ 4 + 0.93 * beta ^ 8) * (1 - ((ptamont - dpdiaph) / (ptamont)) ^ (1 / gamma))
        e = (1 - beta ^ 4) ^ (-0.5)
        u = uo * ((t0 / 293.15) ^ (1.5)) * (113 + 293.15) / (113 + t0)
        Do
            q = co * e * epsi * s * ((2 * dpdiaph * rho) ^ (0.5))
            rey = (4 * q) / (pi * d2 * u)
            a1 = ((19000 * beta) / rey) ^ (0.8)
            c = 0.5961 + 0.0261 * (beta) ^ (2) - 0.216 * (beta) ^ 8 + 0.000521 * ((beta * 10 ^ 6) / rey) ^ (0.7) + (0.0188 + 0.0063 * a1) * beta ^ (3.5) * (10 ^ 6 / rey) ^ 0.3
            If Abs(1 - co / c) <= 10 ^ -6 Then Exit Do
            co = c
            DoEvents
        Loop
        vitis = 4 * q * t0 * 287.04 / (pi * d2 ^ 2 * ptamont)
        a = (gamma * r * t0) ^ (0.5)
        mach = vitis / a
        t = ttamont / (1 + ((gamma - 1) / 2) * mach ^ 2)
        If Abs(1 - t0 / t) <= 10 ^ -6 Then Exit Do
        t0 = t
    Loop
            'Conditions sur calcul de Pt
            If mach < 0.2 Then
            pt = ptamont + (1 / 2) * rho * vitis ^ 2
            End If
            If mach >= 0.2 Then
            pt = ptamont * (1 + (gamma - 1) / 2 * mach ^ 2) ^ (gamma / (gamma - 1))
            End If
    Cells(i, 7).Value = q
    Cells(i, 8).Value = rey
    Cells(i, 9).Value = vitis
    Cells(i, 10).Value = mach
    Cells(i, 11).Value = t
    Cells(i, 12).Value = rho
    Cells(i, 13).Value = u
    Cells(i, 14).Value = pt / 1000
     
    If rey <= 5000 And beta >= 0.1 And beta <= 0.559 Then
        Cells(i, 6).Value = "Rey trop petit"
    End If
     
    If rey <= (16000 * beta ^ 2) And beta > 0.559 Then
        Cells(i, 6).Value = "Rey trop petit"
    End If
     
Loop
End Sub

Bonsoir,
dans le style : pour la ligne  
        cp = r * (3.5 - 2.8 * (10 ^ -5) * t0 + 2.24 * (10 ^ -8) * (t0 ^ 2) + (3090 / t0) ^ 2 * ((Exp(3090 / t0))) / ((Exp(3090 / t0) - 1) ^ 2))  
 
2.8 * (10 ^ -5) et 2.24 * (10 ^ -8) sont-ils des éléments constants? si oui les définir en tête hors de la boucle
ou encore : 3090 / t0 à calculer une fois dans la boucle et Exp(3090 / t0) aussi
Cordialement

 
En effet ils sont constants
 
je vais les sortir de la boucle et faire un seul calcul pour 3090 et exp
 
merci

vitis = 4 * q * t0 * 287.04 / (pi * d2 ^ 2 * ptamont)  
 
4*287.04=cte

s = (pi * d1 ^ 2) / 4  
pi / 4 =cte

ouai c'est vrai que je n'avais pas penser à faire ses optimisations dans un souci de garder la forme des formules.
 
mais je pense que maintenant je vais optimiser

Bonjour,
Pour commencer "typer" tous les dim au mieux, (Byte, Integer, Long, Single, Double...)
Utiliser les symboles : Single ! Double #
Dim i%, j% 'integer
Dim ga!, zo!, bu!  'single
Dim meu#, bla# 'double
 
Charger la plage dans un Array  : L'accès aux données d'un Array est au moins 100 fois plus rapide que l'accès aux cells :
 
Dim Arr()
 
Si ta plage de travail est Range("B1:N50" )
Arr() = Range("B1:N50" )
ensuite
Remplacer tous les cells(x,y).Value par Arr(x,y)
remplacer tous les strings par des mini-string, ou mieux virer les strings    
 
Beta hors tolérance" = "-" par exemple (ou mieux : "" )
"Rey trop petit"  = ""
"DeltaP/P>0.25" = ""
Il sera aisé de modifier le tableau manuellement à la fin des calculs... (ou faire un replace)
 
Après le dernier loop ajouter :
Range("B1:N50" ) = Arr()
 
Nota : Ne pas oublier de croiser les doigts très fort !    
A+

Bonjour,
 
Pour Galopin01:
Existe-t-il un tuto sur les optimisations VBA quelque part?
Si non, penses-tu en faire un? ce serait sympa. Personnellement j'ai des souvenirs d'optimisation de formules qui datent de 1961. Et comme les processors ont changé, je ne suis pas certain que le temps d'une division soit plus long que celui d'une multiplication en 2006.
Cordialement

merci bien je vais essayer

Re,
pour les tutos, j'ai trouvé plein d'adresses en cherchant "optimisation VBA" dans copernic agent
Cordialement

Oui, le tuto le plus complet étant sans doute celui ci
Pour être exaustif on pourrait y rajouter cette observation non citée :
Suppression des Offset
A+

Pour optimisation performances passer à autre chose que VBA : Delphi,C, Asm etc

 
Merci beaucoup
 
En lisant ce tuto j'ai pu passer de 4 secondes pour 2500 calcules à 1.5 secondes
 
pour 1500 calc de 2.1 secondes à 1.1 secondes
 
mission presque accomplie
 
j'ai encore un petit effort à fournir et se sera bon

ça y est 0.90 secondes pour 1500 calcules.
 
cool