Code à optimiser

Bonjour à tous !

Je travail dans le secteur de l'ingénierie et j'aurais besoin d'aide sur un tableur que j'ai récupéré sur internet et qui contient un calcul en VBA.

Etant débutant ("moyen"!) en VBA, j'ai quelques notions mais là, je ne comprends strictement rien à ce code.

En résumé j'ai une feuille qui contient des données d'entrée A, B et C et un calcul par macro est mené pour me donner un résultats R.

Mon problème est que je dois effectuer ce calcul un très grand nombre de fois suivant une multitude de données d'entrée A, B et C pour ainsi récupérer une multitude de résultats R.

J'arrive sans souci à intégrer ce code dans une boucle VBA que j'ai créé afin d'effectuer un grand nombre de calcul en fonction de données d'entrée variables préalablement saisies dans un tableau.

Mon problème est que, pour 1 seul calcul, le code que j'ai récupéré met du temps à s'appliquer (environ 1,5 sec).

Je vous laisse imaginer le temps que cela prend pour une série de plus de 300 données d'entrée !!

Ma question est donc simple : quelqu'un a-t-il la compétence et la gentillesse de voir s'il est possible d'optimiser ce code ???

Merci d'avance. Beaucoup...

A bientôt

Function ATG(N, M, N0)
Pi = 4 * Atn(1)
N1 = N - N0
If Abs(N) < 0.0001 And Abs(M) < 0.0001 Then ATG = -Pi / 2: GoTo 99
If N1 = 0 Then ATG = 0: GoTo 99
If N1 > 0 Then ATG = Pi / 2 - Atn(M / N1) Else ATG = -Atn(M / N1) - Pi / 2
99 End Function
Function procen(tabT, tabr, NEd, MEd)
' Interpolation pour le calcul du pourcentage d'acier
Dim tabN(90, 6), tabM(90, 6), MR(6), NR(6)
If Abs(MEd) + Abs(NEd) = 0 Then procen = 0: GoTo 99
NL = 80  '73
N0 = 0.5 * tabT(80, 1)
    For j = 1 To 5
        For i = 1 To NL
        j1 = (j - 1) * 2 + 1: j2 = 2 * j
        tabN(i, j) = tabT(i, j1)
        tabM(i, j) = tabT(i, j2)
        Next i
    Next j
e = ATG(NEd, MEd, N0)
'procen = e: GoTo 99

    For j = 1 To 5
        For i = 2 To NL  '2 to NL
        N1 = tabN(i, j): M1 = tabM(i, j)
        e1 = ATG(N1, M1, N0)
        If e1 > e Then i1 = i: GoTo 18
        Next i
    GoTo 33
18  N2 = tabN(i1 - 1, j): M2 = tabM(i1 - 1, j)
    e2 = ATG(N2, M2, N0)
'procen = e2: GoTo 99

    k = (e - e2) / (e1 - e2)
    MR(j) = M2 + (M1 - M2) * k
    NR(j) = N2 + (N1 - N2) * k
33  Next j
If Abs(NEd - N0) / N0 > 0.35 Then GoTo 55
If MEd > MR(5) Then procen = 1000: GoTo 99
If MEd < MR(1) Then procen = tabr(1): GoTo 99
    For j = 1 To 4
    If MEd > MR(j) Then j1 = j: GoTo 51
    Next j
51 j2 = j1 + 1
k = (MEd - MR(j1)) / (MR(j2) - MR(j1))
GoTo 90
55 If e < 0 And NEd > NR(1) Then procen = tabr(1): GoTo 99
If e > 0 And NEd < NR(1) Then procen = tabr(1): GoTo 99
If e < 0 And NEd < NR(5) Then procen = 1000: GoTo 99
If e > 0 And NEd > NR(5) Then procen = 1000: GoTo 99
    For j = 5 To 1 Step -1
    If e < 0 And NEd < NR(j) Then j1 = j: GoTo 24
    If e > 0 And NEd > NR(j) Then j1 = j: GoTo 24
    Next j
24 j2 = j1 + 1
k = (NEd - NR(j1)) / (NR(j2) - NR(j1))

90 procen = tabr(j1) + (tabr(j2) - tabr(j1)) * k
99 End Function
Function fsc(e, fcd, ec2, ecu2, N)
' calcul de la contrainte du béton en diagramme PR
If ecu2 > 5 Then Ecm = ecu2: ec1 = ec2: GoTo 12 'Sargin
' parabole-rectangle
If e = 0 Then s = 0: GoTo 10
If e > ec2 Then s = fcd: GoTo 10
s = fcd * (1 - (1 - e / ec2) ^ N)
GoTo 10
12 'Sargin
eta = e / ec1
k = 1.05 * Ecm / 1.2 * e / fcd
s = fcd * (k * eta - eta * eta) / (1 + (k - 2) * eta)
10 fsc = s
End Function
Function fscg(e, fcd, ec1, Ecm)
' calcul de la contrainte du béton en diagramme Sargin
If e = 0 Then s = 0: GoTo 10
k = 1.05 * Ecm / 1.2 * ec1 / fcd
eta = e / ec1
s = fcd * (k * eta - eta * eta) / (1 + (k - 2) * eta)
10 fscg = s
End Function
Function sis(eps, fyk, gs, euk, k)
' contrainte acier en fonction de epsilonns
If eps = 0 Then sis = 0: GoTo 102
es = 200
ep1 = Abs(eps)
eud = 0.9 * euk
fyd = fyk / gs
If ep1 < fyd / es Then sis = es * ep1: GoTo 101
If k = 1 Then sis = fyd: GoTo 101
pent = (k - 1) * fyd / (euk - fyd / es)
If ep1 > eud Then ep1 = eud
sis = fyd + pent * (ep1 - fyd / es)
101 If eps < 0 Then sis = -sis
102 End Function
Function pmA(GB)
' pourcentage minimal d'armature
pmA = 0
Pi = 4 * Atn(1)
If GB > 0.6 Then GoTo 99
Ac = Pi * GB * GB / 4 * 10000
If Ac <= 5000 Then pmA = 0.005 * Ac: GoTo 99
If Ac > 10000 Then pmA = 0.0025 * Ac: GoTo 99
pmA = 25
99 End Function
Function excen(N, M, B)
If N = 0 Then e = B / 2: GoTo 10
e = M / N
10 excen = e 'excen = B / 2 - e
99 End Function
Function fNMR(kmu, N, GB, eb, eh, fcd, ec2, ecu2, nx, fyk, gs, euk, ka, nac, enr, phi, code)
' calcul de l'effort normal résistant et du moment résistant du béton d'une section
' circulaire comprimée sur une hauteur x avec déformations eh en haut et eb en bas
Pi = 4 * Atn(1)
Ac = Pi * phi * phi / 4 * kmu / 100
If eb = eh Then x = GB Else x = GB * eh / (eh - eb)
NR = 0: MR = 0
If eh <= 0 Then GoTo 24
    For i = 0 To N
    y = x * i / N
    If y = GB Then B = 0: GoTo 14
    If GB * GB / 4 - (GB / 2 - y) * (GB / 2 - y) <= 0 Then B = 0: GoTo 14
    B = 2 * Sqr(GB * GB / 4 - (GB / 2 - y) * (GB / 2 - y))
14  e = eh + (eb - eh) * y / GB   ' If eb = eh Then e = eb: GoTo 11
11  s = fsc(e, fcd, ec2, ecu2, nx)
    If i / 2 = Int(i / 2) Then k = 2 Else k = 4
    If i = 0 Or i = N Then k = 1
    dN = B * s * k
    dM = dN * y
    NR = NR + dN
    MR = MR + dM
    Next i
NR = NR / 3 / N * x
MR = MR / 3 / N * x
BRc = NR: MRc = MR
24 r = GB / 2 - enr ' rayon des armature
    For i = 1 To nac ' pour chaque barre
    theta = (i - 1) / nac * 2 * Pi
    y = r * Cos(theta)
    Z = GB / 2 - y
    eps = eh + (eb - eh) * Z / GB
    ss = sis(eps, fyk, gs, euk, ka)
    dN = Ac * ss / 10000
    NR = NR + dN
    MR = MR + dN * Z
    Next i
MR = NR * GB / 2 - MR
If code = 1 Then fNMR = NR Else fNMR = MR
99 End Function

Bonjour et bienvenue sur le forum Bartolomeo33290,

Optimiser un code (qui plus est dans un domaine aussi pointu) sans l'aide d'un fichier excel exemple me parait bien difficile.

Peut-être qu'en joignant un fichier simplifié et en disant comment tu procèdes pour lancer 1 calcul puis comment tu as intégré ça dans ta boucle, tu auras peut-être plus de chances...

Merci pour votre réponse et désolé pour le retard de ma réponse...

Je m'apprête à fermer mon compte sur "excel-pratique".

Pourriez-vous supprimer ce sujet du forum ?

Merci d'avance.

A bientôt !

Rechercher des sujets similaires à "code optimiser"