Excel bugge lorsque je lance ma macro, problème de boucle?
Bonjour, j'ai un problème dans mon code VBA. Dans cette partie de mon programme,j'essaie d'optimiser une valeur initiale d'un problème C(0,t). Je dispose déja d'une valeur de C(0,t) qui m'a donnée une erreur d'un signe que je ne connais pas et j'aimerais obtenir une autre valeur de C(0,t) qui me donnerait une erreur du signe contraire pour ensuite appliquer une méthode de dichotomie.. J'ai essayé de faire cette algorithme sur VBA seulement, lorsque je lance la macro, excel ne répond plus... J'imagine que je le fais boucler a cause d une erreur dans mon code mais je ne vois pas ou et je n ai aucun message d erreur en compilant...
Mon code ressemble à ceci:
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
' Check if the error is of the opposite sign
' For the concentrations
For i = 1 To n
Do Until (ERROR_C(i) / ERROR_C1) < 0
If Abs(ERROR_C(i)) > Abs(ERROR_C(i - 1)) Then
C(0, t) = 1.01 * C(0, t)
Else: C(0, t) = 0.98 * C(0, t)
End If
C(1, t) = C(0, t) + deltaz * KM * (Ke * C(0, t) - Cga) / D
For z = 2 To NS
C(z, t) = deltaz ^ 2 / (D * deltat) * (C(z - 1, t) - C(z - 1, t - 1)) + D / D * (2 * C(z - 1, t) - C(z - 2, t))
Next z
ERROR_C(i) = (C(NS, t) - C(NS - 1, t)) / C(NS, t) 'Recalculation of the new error which will be compared to ERROR_C1
Loop
Next i |
Ma dichotomie est codée de cette facon:
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
' Now we are supposed to have LIMIT1/ERROR1 and LIMIT2/ERROR2 for contrations and temperatures so we
' can implement the successive division method. Verify second boundary conditions
Line1:
C(0, t) = (LIMIT_C1 + LIMIT_C2) / 2
C(1, t) = C(0, t) + deltaz * KM * (Ke * C(0, t) - Cga) / D
For z = 2 To NS
C(z, t) = deltaz ^ 2 / (D * deltat) * (C(z - 1, t) - C(z - 1, t - 1)) + D / D * (2 * C(z - 1, t) - C(z - 2, t))
Next z
ERRORC = (C(NS, t) - C(NS - 1, t)) / C(NS, t)
' Test for the concentrations and new limit
If ERRORC > ACCEPTABLE_C Then
If ERRORC / ERROR_C1 < 0 Then
LIMIT_C2 = C(0, t)
ERROR_C2 = ERRORC
Else
LIMIT_C1 = C(0, t)
ERROR_C1 = ERRORC
End If
GoTo Line1
End If |
Quelqu un y voit il plus clair que moi et peut il me donner une piste? N hesiter pas a me poser des questions, je n ai surement pas été clair dans mon intitulé...
Merci d'avance
En attendant un signe d'une jolie boucle VBA
Il y a beaucoup trop de variables inconnues sans aucun type pour aider à optimiser. Ainsi on parle d'une valeur de C(0, t) sans indiquer s'il s'agit d'un Double ou Single ou Long ou ...
Essayez d'indenter le code selon la structure des If ou For imbriqués. Cela améliore nettement la lisibilité.
Utilisez des constantes telles que deltaAbove1 et deltaBelow1. C'est également plus lisible et plus rapide à l'exécution. Sortez les invariants de boucles comme delta_z_SqrDivDt ou deltaHalf. Limitez le nombre d'itérations à un nombre maximum nbrMaxIteration fixé à l'avance
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
| Option Explicit ' Concentrations and temperatures
' Check if the error is of the opposite sign for the concentrations
Sub ConcentrateOppositeSign(ByVal NS As Integer)
Const deltaAbove1 = 1.01, deltaBelow1 = 0.98, deltaHalf = 0.5, nbrMaxIteration = 100000
Dim tStart As Double, tEnd As Double, i As Integer, z As Integer
Dim arrCt(0 To NS) As Double, indCt As Integer
Dim delta_z_SqrDivDt As Double, nbrIteration As Long
For indCt = 0 To NS: arrCt(indCt) = C(indCt, t): Next ' Save array 2D to 1 D
' Calculate the invariants of loop outside the For Next to optimize the perf.
delta_z_SqrDivDt = deltaz * deltaz / (D * deltat) ' was deltaz ^ 2 / (D * deltat)
nbrIteration = 0
For i = 1 To n
StsBar "Loop n° " & i & " nbrIteration = " & nbrIteration
tStart = Time
Do Until ERROR_C(i) < 0 ' Was (ERROR_C(i) / ERROR_C1) Let's suppose ERROR_C1 > 0
If Abs(ERROR_C(i)) > Abs(ERROR_C(i - 1)) Then
arrCt(0) = deltaAbove1 * arrCt(0) ' Modification of the seed
Else
arrCt(0) = deltaBelow1 * arrCt(0) ' of the series
End If
' Propagate the seed C(0,t) to the next element C(1, t)
arrCt(1) = arrCt(0) + deltaz * KM * (Ke * arrCt(0) - Cga) / D
For z = 2 To NS ' General propagation to the next elements including at t - 1
arrCt(z) = delta_z_SqrDivDt * (arrCt(z - 1) - C(z - 1, t - 1)) + _
deltaHalf / (arrCt(z - 1) - arrCt(z - 2))
' Was C(z, t) = deltaz ^ 2 / (D * deltat) * (C(z - 1, t) - C(z - 1, t - 1)) + D / D * (2 * C(z - 1, t) - C(z - 2, t))
Next
' Recalculation of the new error which will be (NOT?) compared to ERROR_C1
ERROR_C(i) = (arrCt(NS) - arrCt(NS - 1)) / arrCt(NS)
nbrIteration = nbrIteration + 1
If nbrIteration >= nbrMaxIteration Then
Debug.Print "No change of sign after " & nbrMaxIteration & " iterations"
Exit Do
End If
Loop
tEnd = Time
Debug.Print "ConcentrateOppositeSign " & i & " in " & Format(tEnd - tStart, "HH:MM:SS")
Debug.Print "Number of iterations : " & nbrIteration
Next
For indCt = 0 To NS: C(indCt, t) = arrCt(indCt): Next ' Save array 1D to 2D
End Sub
Sub StsBar(ByVal strMsg As String)
Application.StatusBar = strMsg
End Sub |
La condition du Do Until attend le changement de signe ERROR_C(i) / ERROR_C1
ERROR_C1 semble une variable qui n'est pas modifiée dans la boucle sans fin. Si c'est une constante, il aurait fallu indiquer sa déclaration comme toutes les variables utilisées dans la procédure.
Diviser ERROR_C(i) par ERROR_C1 ne semble pas utile pour tester le changement de signe de ERROR_C(i) si jamais il arrive.
Le nom des variables sur une seule lettre n'aide pas à la compréhension.
On ne voit guère l'intérêt de diviser D par D. Cela devrait faire toujours 1.
On pourrait optimiser en copiant la mesure de concentration C(0, t) à C(NS, t) dans un tableau (array) à une seule dimension arrCt avant la boucle et la restaurer après.
On a instrumenté le code pour voir le temps d'une ou plusieurs itérations entre tEnd et tStart sans pouvoir tester. On a animé la barre de status d'Excel avec le n° de boucle.
Dans la fenêtre d'Exécution immédiate (Ctrl+G) du VBE, Debug.Print affiche également la progression dans la boucle.
___________
Si la discussion est résolue, vous pouvez cliquer sur le bouton :resolu:
En bas de ce message s'il vous a apporté des éléments de réponse pertinents, pensez également à voter en cliquant sur le bouton vert http://www.developpez.net/forums/ima.../vote1left.gif ci-dessous.
