[XL-2003] code vba dynamique [Résolu]

HERBINE · 08/10/2011, 15h36

Bonjour
Le code suivant permet de calculer les coefficients trimestriels sur 3 ans. Mon problème, est –il possible de rendre dynamique ce code : je m’explique lorsque j’ai une serie de données trimestrielle par exemple sur 4 ans je dois diviser par 4, sur 5 ans divisé par 5 etc. donc changer le code ci-dessous à chaque foi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'calcul des Coefficients saisonniers trimestriels sur 3 ans 
Trim1 = (.Range("F2").Value + .Range("F6").Value + .Range("F10").Value) / 3
Trim2 = (.Range("F3").Value + .Range("F7").Value + .Range("F11").Value) / 3
Trim3 = (.Range("F4").Value + .Range("F8").Value + .Range("F12").Value) / 3
Trim4 = (.Range("F5").Value + .Range("F9").Value + .Range("F13").Value) / 3

Merci pour votre aide
Bien cordialement

herbine

mercatog · 08/10/2011, 15h40

Bonjour
C'est possible, mais il fallait décrire ton classeur (disposition des données) et reporter ton code en entier

HERBINE · 08/10/2011, 15h45

voila mon code en entier ainsi que le fichier
merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Sub calCoeff()
'déclaration des variables
Dim a As Double, b As Double
Dim Sx As Double, Sy As Double, Sx2 As Double, Sy2 As Double
Dim Sxy As Double, mx As Double, my As Double
Dim i As Integer, n As Integer
Dim DerLig As Long
' initialisation des données
Sx = 0
Sy = 0
Sx2 = 0
Sxy = 0
mx = 0
my = 0
n = 0
'1ere boucle de traitement
With Worksheets("CoefSaisonnier")
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To DerLig
    Sx = Sx + .Cells(i, 1).Value
    Sy = Sy + .Cells(i, 2).Value
    Sx2 = Sx2 + .Cells(i, 1).Value ^ 2
    Sy2 = Sy2 + .Cells(i, 2).Value ^ 2
    Sxy = Sxy + .Cells(i, 1).Value * .Cells(i, 2).Value
    .Cells(i, 3).Value = .Cells(i, 1).Value * .Cells(i, 2).Value
    .Cells(i, 4).Value = .Cells(i, 1).Value ^ 2
    n = n + 1
Next i
' calcul des moyennes x et y
mx = Sx / n
my = Sy / n
' calcul de a, b et r
a = (Sxy - n * mx * my) / (Sx2 - n * mx ^ 2)
b = my - a * mx
 
' affichage de la droite d'équation
If b > 0 Then
    .Cells(13, 8) = "y = " & Format(a, "### ##0.000") _
        & " x +" & Format(b, "### ##0.00")
End If
 
If b < 0 Then
        .Cells(13, 8) = "y = " & Format(a, "### ##0.000") _
        & " x " & Format(b, "### ##0.00")
End If
 
' affichage des premiers résultats
.Cells(4, 8).Value = a
.Cells(5, 8).Value = b
.Cells(6, 8).Value = mx
.Cells(7, 8).Value = my
.Cells(8, 8).Value = n
.Cells(9, 8).Value = Sx
.Cells(10, 8).Value = Sy
.Cells(11, 8).Value = Sxy
.Cells(12, 8).Value = Sx2
 
'2eme boucle de traitement
For i = 2 To DerLig
    .Cells(i, 5).Value = .Cells(4, 8).Value * .Cells(i, 1).Value + .Cells(5, 8).Value
    If .Cells(i, 5).Value <> 0 Then
        .Cells(i, 6).Value = .Cells(i, 2).Value / .Cells(i, 5).Value
    End If
Next i
'calcul des Coefficients saisonniers trimestriels
Trim1 = (.Range("F2").Value + .Range("F6").Value + .Range("F10").Value) / 3
Trim2 = (.Range("F3").Value + .Range("F7").Value + .Range("F11").Value) / 3
Trim3 = (.Range("F4").Value + .Range("F8").Value + .Range("F12").Value) / 3
Trim4 = (.Range("F5").Value + .Range("F9").Value + .Range("F13").Value) / 3
' prévisions brutes
prévisionBrut1 = .Range("H4").Value * .Range("H24").Value + .Range("H5").Value
prévisionBrut2 = .Range("H4").Value * .Range("H25").Value + .Range("H5").Value
prévisionBrut3 = .Range("H4").Value * .Range("H26").Value + .Range("H5").Value
prévisionBrut4 = .Range("H4").Value * .Range("H27").Value + .Range("H5").Value
' prévisions saisonnalisées
prévisionSaiso1 = prévisionBrut1 * Trim1
prévisionSaiso2 = prévisionBrut2 * Trim2
prévisionSaiso3 = prévisionBrut3 * Trim3
prévisionSaiso4 = prévisionBrut4 * Trim4
 
' affichage des autres résultats
.Cells(18, 8).Value = Trim1
.Cells(19, 8).Value = Trim2
.Cells(20, 8).Value = Trim3
.Cells(21, 8).Value = Trim4
 
.Cells(24, 9).Value = prévisionBrut1
.Cells(25, 9).Value = prévisionBrut2
.Cells(26, 9).Value = prévisionBrut3
.Cells(27, 9).Value = prévisionBrut4
 
.Cells(24, 10).Value = prévisionSaiso1
.Cells(25, 10).Value = prévisionSaiso2
.Cells(26, 10).Value = prévisionSaiso3
.Cells(27, 10).Value = prévisionSaiso4
End With
End Sub

mercatog · 08/10/2011, 16h00

Ci-joint une petite fonction qui permet de te calculer tes coefficients

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Function CoefTrim(Rng As Range, ByVal Trm As Byte) As Double
Dim n As Integer, i As Integer
Dim S As Double
 
n = CInt(Rng.Count / 4)
For i = 1 To Rng.Count Step 4
    S = S + Rng(i + Trm - 1)
Next i
CoefTrim = S / n
End Function

Si les données dans ton fichiers sont de F2 à FDerlig, tu auras quelque chose comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
'.....
    Trim1 = CoefTrim(.Range("F2:F" & DerLig), 1)
    Trim2 = CoefTrim(.Range("F2:F" & DerLig), 2)
    Trim3 = CoefTrim(.Range("F2:F" & DerLig), 3)
    Trim4 = CoefTrim(.Range("F2:F" & DerLig), 4)
'.....suite

HERBINE · 08/10/2011, 16h38

la fonction ne marche pas j'ai du faire une mauvaise manipulation
mon probleme comment l'adapter à mon code suivant :
'calcul des Coefficients saisonniers trimestriels sur 3 ans

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Trim1 = (.Range("F2").Value + .Range("F6").Value + .Range("F10").Value) / 3
Trim2 = (.Range("F3").Value + .Range("F7").Value + .Range("F11").Value) / 3
Trim3 = (.Range("F4").Value + .Range("F8").Value + .Range("F12").Value) / 3
Trim4 = (.Range("F5").Value + .Range("F9").Value + .Range("F13").Value) / 3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Function CoefTrim(Rng As Range, ByVal Trm As Byte) As Double
Dim n As Integer, i As Integer
Dim S As Double
 
n = CInt(Rng.Count / 4)
For i = 1 To Rng.Count Step 4
    S = S + Rng(i + Trm - 1)
Next i
CoefTrim = S / n
End Function

mercatog · 08/10/2011, 16h39

La fonction précédente suppose que la plage de calcul comporte un nombre de cellules multiple de 4.
Sinon, une amélioration à la fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Function CoefTrim(Rng As Range, ByVal Trm As Byte) As Double
Dim n As Integer, i As Integer
Dim S As Double
 
n = Rng.Count \ 4
For i = 1 To 4 * n Step 4
    S = S + Rng(i + Trm - 1)
Next i
CoefTrim = S / n
End Function

Plus généralement (mensuel, trimestriel ou semestriel), une fonction généralisée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'Rng: Plage de calcul des coefficients
'Periode: 12: mensuel, 4: Trimestriel, 2, semestriel
'Indice: le n° de la periode: de 1 à Periode (Si Periode=4 (Trimestriel): Indice: 1, 2, 3 ou 4)
Function CoefSais(Rng As Range, ByVal Periode As Byte, ByVal Indice As Byte) As Double
Dim n As Integer, i As Integer
Dim S As Double
 
If Indice >= 1 And Indice <= Periode Then
    n = Rng.Count \ Periode
    For i = 1 To Periode * n Step Periode
        S = S + Rng(i + Indice - 1)
    Next i
    CoefSais = S / n
End If
End Function

EDIT

Citation:

la fonction ne marche pas j'ai du faire une mauvaise manipulation

Relis la réponse #4

HERBINE · 08/10/2011, 17h02

merci beaucoup pour votre savoir mercatog ça marche

mercatog · 08/10/2011, 17h24

Pour plus de rapidité, tu peux travailler avec des variables tableaux.
Ci-joint ton code optimisé à l'aide des variables tableaux (à étudier)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Private Function CoefTrim(ByVal Tb As Variant, ByVal Trm As Byte) As Double
Dim n As Integer, i As Integer
Dim S As Double
 
n = UBound(Tb, 1) \ 4
For i = 1 To 4 * n Step 4
    S = S + Tb(i + Trm - 1, 1)
Next i
CoefTrim = S / n
End Function
 
Sub CalCoeff()
Dim Sx As Double, Sy As Double, Sx2 As Double, Sy2 As Double, Sxy As Double, Mx _
                                                                             As Double, My As Double
Dim TabTrim() As Double, Prevision() As Double
Dim i As Long, n As Long, DerLig As Long
Dim a As Double, b As Double
Dim Frm As String
Dim k As Byte
Dim TabData
 
Application.ScreenUpdating = False
'1ere boucle de traitement
With Worksheets("CoefSaisonnier")
    DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A2:F" & DerLig)
    For i = 1 To DerLig - 1
        Sx = Sx + TabData(i, 1)
        Sy = Sy + TabData(i, 2)
        Sx2 = Sx2 + TabData(i, 1) ^ 2
        Sy2 = Sy2 + TabData(i, 2) ^ 2
        Sxy = Sxy + TabData(i, 1) * TabData(i, 2)
        TabData(i, 3) = TabData(i, 1) * TabData(i, 2)
        TabData(i, 4) = TabData(i, 1) ^ 2
    Next i
    n = DerLig - 1
    ' calcul des moyennes x et y
    Mx = Sx / n
    My = Sy / n
    ' calcul de a, b et r
    a = (Sxy - n * Mx * My) / (Sx2 - n * Mx ^ 2)
    b = My - a * Mx
 
    ' affichage de la droite d'équation
    Frm = "y = " & Format(a, "### ##0.000") & " x"
    If b > 0 Then
        Frm = Frm & " +" & Format(b, "### ##0.00")
    ElseIf b < 0 Then
        Frm = Frm & Format(b, "### ##0.00")
    End If
 
    '2eme boucle de traitement
    For i = 1 To DerLig - 1
        TabData(i, 5) = a * TabData(i, 1) + b
        If TabData(i, 5) <> 0 Then TabData(i, 6) = TabData(i, 2) / TabData(i, 5)
    Next i
 
    ' affichage des premiers résultats
    .Range("H4:H13") = Application.Transpose(Array(a, b, Mx, My, n, Sx, Sy, Sxy, _
                                                   Sx2, Frm))
    .Range("A2:F" & DerLig) = TabData
 
    'calcul des Coefficients saisonniers trimestriels
    TabData = .Range("F2:F" & DerLig)
    ReDim TabTrim(1 To 4, 1 To 1)
    For k = 1 To 4
        TabTrim(k, 1) = CoefTrim(TabData, k)
    Next k
    ' prévisions brutes et prévisions saisonnalisées
 
    TabData = .Range("H24:H27")
    ReDim Prevision(1 To 4, 1 To 2)
    For k = 1 To 4
        Prevision(k, 1) = a * TabData(k, 1) + b
        Prevision(k, 2) = Prevision(k, 1) * TabTrim(k, 1)
    Next k
 
    ' affichage des autres résultats
    .Range("H18:H21") = TabTrim
    .Range("I24:J27") = Prevision
End With
End Sub

HERBINE · 08/10/2011, 19h14

merci pour le code je vais l'étudier

08/10/2011, 15h40	#2
mercatog Expert Confirmé Sénior Inscription : juillet 2008 Messages : 5 848 Détails du profil Informations forums : Inscription : juillet 2008 Messages : 5 848 Points : 13 907 Points : 13 907	Bonjour C'est possible, mais il fallait décrire ton classeur (disposition des données) et reporter ton code en entier __________________ Cordialement.
	00

08/10/2011, 17h02	#7
HERBINE Invité de passage Inscription : mai 2008 Messages : 27 Détails du profil Informations forums : Inscription : mai 2008 Messages : 27 Points : 3 Points : 3	code vba merci beaucoup pour votre savoir mercatog ça marche
	00

08/10/2011, 19h14	#9
HERBINE Invité de passage Inscription : mai 2008 Messages : 27 Détails du profil Informations forums : Inscription : mai 2008 Messages : 27 Points : 3 Points : 3	code vba merci pour le code je vais l'étudier
	00

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email