Code à optimiser !!

Y compris Power BI, Power Query et toute autre question en lien avec Excel
B
Bartolomeo33290
Nouveau venu
Nouveau venu
Messages : 2
Inscrit le : 6 janvier 2016
Version d'Excel : 2013 FR

Message par Bartolomeo33290 » 6 janvier 2016, 18:32

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. :evil: :evil:
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... :D
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

v
vba-new
Membre impliqué
Membre impliqué
Messages : 2'946
Appréciations reçues : 2
Inscrit le : 13 mai 2009
Version d'Excel : 2010 FR - 2013 FR

Message par vba-new » 10 janvier 2016, 01:19

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...
vba-new
B
Bartolomeo33290
Nouveau venu
Nouveau venu
Messages : 2
Inscrit le : 6 janvier 2016
Version d'Excel : 2013 FR

Message par Bartolomeo33290 » 25 février 2016, 21:45

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 !
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message
  • Optimiser mon code
    par Nrev74 » 17 novembre 2016, 13:38 » dans Excel - VBA
    4 Réponses
    149 Vues
    Dernier message par Nrev74
    21 novembre 2016, 12:42
  • optimiser et reduire un code
    par EricM38 » 1 janvier 2017, 22:15 » dans Excel - VBA
    2 Réponses
    110 Vues
    Dernier message par EricM38
    2 janvier 2017, 11:00
  • Optimiser code VBA
    par DRB_Fred » 14 octobre 2018, 20:08 » dans Excel - VBA
    3 Réponses
    74 Vues
    Dernier message par dhany
    14 octobre 2018, 21:59
  • optimiser un code vba ?
    par babouze64 » 29 novembre 2016, 18:22 » dans Excel - VBA
    1 Réponses
    272 Vues
    Dernier message par h2so4
    29 novembre 2016, 19:15
  • Optimiser code VBA
    par GGautier » 19 juin 2019, 11:18 » dans Excel - VBA
    6 Réponses
    128 Vues
    Dernier message par GGautier
    19 juin 2019, 14:06
  • Optimiser son Code VBA
    par abakisi » 8 juin 2017, 15:10 » dans Excel - VBA
    2 Réponses
    292 Vues
    Dernier message par abakisi
    8 juin 2017, 17:33