• Initiateur de la discussion Initiateur de la discussion verd
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

V

verd

Guest
Bonjour,

Pourriez-vous m'aider à rendre cette macro (c'est ma première) moins lente et l'améliorer si possible? 🙂

Sub flux()
Application.ScreenUpdating = False
Range('V2:V8761').Clear
Dim i As Integer
Dim j As Integer
Dim dQ As Double
Dim dP As Double
Dim dT As Double
Dim P As Double
Dim Tair As Double

For i = 1 To 8760
P = 0
Tair = Range('T2:T8761')(i)
Tsol = Range('U2:U8761')(i)

For j = 1 To 200
dQ = 0
dP = 0
dT = 0
dQ = ((Tsol - Tair) * Range('B29') * Range('B30')) / Range('B26')
dT = dQ / (Range('B4') * Range('B5') * Range('B31'))
Tair = Tair + dT
dP = dQ / Range('B30')
P = P + dP
Next j
Range('V2:V8761')(i) = P
Next i
Application.ScreenUpdating = False
End Sub


MERCI
 
Bonjour,
Pour répondre à vos questions:
Cette macro sert à calculer l'énergie récupérée par un tube enterré. La première boucle est la discrétisation temporelle heure par heure sur une année et la seconde, la discrétisation spatiale sur la longueur du tube.
Note: Je n'ai pas réellement besoin des 8760 valeurs (inutile de remplir la colonne V, c'est peut-etre cela qui ralentit...), mais seulement de leur somme de valeurs positives.
Bonne journée.
 
Bonjour verd, bonjour Justine, bonjour José,
bonjour à toutes et à tous 🙂

verd, sans comprendre tes calculs, je te propose une possibilité qui, si elle augmente la longueur de la procédure, devrait notablement en diminuer le temps d'exécution :

Option Explicit

Sub flux()

'----------------------------
Dim OldCalculation As Long
'----------------------------
Dim i As Integer
Dim j As Integer
'----------------------------
Dim DerLigne As Long
'----------------------------
Dim dQ As Double
Dim dP As Double
Dim dT As Double
Dim P As Double
'----------------------------
Dim VarB4 As Double
Dim VarB5 As Double
Dim VarB26 As Double
Dim VarB29 As Double
Dim VarB30 As Double
Dim VarB31 As Double
'----------------------------
Dim T_Air As Variant
Dim T_Sol As Variant
'----------------------------
Dim T_Resultat() As Double
'----------------------------
Dim CurrentTAir As Double
Dim CurrentTSol As Double
'----------------------------

  With Application
    OldCalculation = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
  End With

  Range('V2:V' & Range('V65536').End(xlUp).Row).ClearContents

  With Application.WorksheetFunction
    DerLigne = .Min(Range('T65536').End(xlUp).Row, _
                    Range('U65536').End(xlUp).Row)
  End With

  T_Air = Range('T2:T' & DerLigne).Value
  T_Sol = Range('U2:U' & DerLigne).Value

  '-------------------------
  ' Modification ici
  '-------------------------
  ' ReDim T_Resultat(1 To DerLigne, 1 To 1)

  ReDim T_Resultat(1 To DerLigne - 1, 1 To 1)
  '-------------------------



  VarB4 = Range('B4')
  VarB5 = Range('B5')
  VarB26 = Range('B26')
  VarB29 = Range('B29')
  VarB30 = Range('B30')
  VarB31 = Range('B31')

  '-------------------------
  ' Modification ici
  '-------------------------
  ' For i = 1 To DerLigne

  For i = 1 To DerLigne - 1
  '-------------------------
    P = 0#
    '-------------------------
    ' Modification ici
    '-------------------------
    ' CurrentTAir = T_Air(i)
    ' CurrentTSol = T_Sol(i)

    CurrentTAir = T_Air(i, 1)
    CurrentTSol = T_Sol(i, 1)
    '-------------------------

    For j = 1 To 200
      dQ = 0#
      dP = 0#
      dT = 0#
      dQ = ((CurrentTSol - CurrentTAir) * VarB29 * VarB30) / VarB26
      dT = dQ / (VarB4 * VarB5 * VarB31)
      CurrentTAir = CurrentTAir + dT
      dP = dQ / VarB30
      P = P + dP
    Next j

    T_Resultat(i, 1) = P

  Next i

  '-------------------------
  ' Modification ici
  '-------------------------
  ' Range('V2:V' & DerLigne) = T_Resultat

  Range('V2').Resize(UBound(T_Resultat)) = T_Resultat
  '-------------------------

  With Application
    .Calculation = OldCalculation
    .ScreenUpdating = True
  End With

End Sub

Explication : Les lectures de propriétés ralentissent l'exécution du code. L'utilisation de variables intermédiaire lorsque les propriétés sont souvent appelées (cas de tes Range().Value) a d'énormes conséquences sur la vitesse d'exécution.
Pour l'accélérer encore, le code utilise des tableaux.

En espérant que cela réponde à ta demande :unsure: . J'ai compilé sans problème mais je n'ai rien pu tester car je n'avais pas de données (et pas spécialement envie de les créer ex nihilo).

A+ 😉

Message édité par: Charly2, à: 06/06/2006 20:54
 
re José, re à tous,

C'est bien possible :whistle: . Difficile à dire sans voir les données et sans trop comprendre les calculs appliqués.

Mais malgré tout, boucler 200 fois dans chaque cellule avec une formule de calcul, bonjour les temps de recalcul :sick:

Alors ZOP ou pas :-\\ ? Let's wait a little :S

A+
 
Merci pour vos réponses.
J'ai essayé le code de Charly2, mais j'obtiens l'erreur 'l'indice n'appartient pas à la sélection' à la ligne CurrentTAir = T_Air(i)
J'ai mis en pièce jointe les données si ca peut vous aider à m'aider 🙂
Bonne soirée
 
re-re-re, etc. 🙂

Oups !!! :sick:

J'ai repéré plusieurs erreurs d'inattention :silly: :whistle:

Essaie avec le code copié dans le classeur joint (j'ai indiqué les modifs).

[file name=verd_code.zip size=6960]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/verd_code.zip[/file]

Va falloir que j'me repose, moi, à moins que j'aille tailler mes rosiers :woohoo:

Tiens-nous au courant...

A+ 😉
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
5
Affichages
915
Réponses
4
Affichages
735
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Réponses
7
Affichages
371
Retour