Discussion :

[joel50]

Bonjour
Malgré mes recherche, je ne trouve pas de solution à mon problème mathématique. J'ai transposer en VBA, non sans mal vu mon niveau et avec beaucoup d'aide sur ce forum, les formules (simple) que j'ai dans mes tableaux de données en VBA.
Il m'en reste une sur laquelle je sèche complétement, mais vraiment complétement.

Ma formule Excel, fait un calcul de moyenne glissante sur une campagne et je la remet à zéro chaque 1er avril. Formule EXCEL : '=MOYENNE(G$7:G7), qui en glissant s'incrémente jusqu'à '=MOYENNE(G$7:G18), puis '=MOYENNE(G$19:G19) est ainsi de suite chaque année. Cf classeur joint. Se pose également le problème en début de tableau qui ne commence pas forcement un 1er avril.

Et pour corser le tout, j'ai un formulaire "créer" qui dans mon classeur initial à environ 200 données et des formulaire "modifier" qui me permet des mise en jour par catégorie. Pour les autre opération j'ai réussi à tous faire calculer, mais là je ne sait même pas par quel bout commencer.

Merci de votre aide, si ma demande est techniquement possible.
Joël

[vinc_bilb]

Bonsoir,

Je ne sais pas si ça aide, mais ça fait ce que j'attendais / compris (non optimisé): je fais juste une RAZ du compteur et moyenne quand le mois '4' est détecté

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
 
Sub Test1()
 
Dim DMonth As Integer
Dim SrcRng As Range
Dim SumVal  As Double, CntVal As Integer
Dim RowN As Integer, ColN As Integer
 
Set SrcRng = ThisWorkbook.Worksheets("Données").Range("A3").CurrentRegion
CntVal = 0
SumVal = 0
 
For RowN = 2 To SrcRng.Rows.Count
 
    If IsDate(SrcRng(RowN, 1)) Then     'Peut être supprimé si c'est toujours une date
 
        DMonth = Month(SrcRng(RowN, 1))
        Debug.Print RowN, SrcRng(RowN, 1), DMonth
 
        If DMonth = 4 Then
            CntVal = 0
            SumVal = 0
        End If
 
        CntVal = CntVal + 1
        SumVal = SumVal + SrcRng(RowN, 7)
        SrcRng(RowN, 9) = SumVal / CntVal
 
    End If
 
Next RowN
 
End Sub

Bonne soirée
Vincent

[joel50]

Bonsoir Vincent et merci
Bonsoir à tous

Je vais tester et essayer de comprendre pour l'intégrer à mon code et je donne des nouvelles (peut être pas ce soir).
Bonne soirée
Joël

[vinc_bilb]

Bonjour,

J'ajoute à la volée quelques commentaires dans le code

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
 
Sub Test1()
 
Dim DMonth As Integer
Dim SrcRng As Range
Dim SumVal  As Double, CntVal As Integer
Dim RowN As Integer, ColN As Integer
 
Set SrcRng = ThisWorkbook.Worksheets("Données").Range("A3").CurrentRegion 'Ca revient à faire un CTLR+ * excel sur le range A3
CntVal = 0
SumVal = 0
 
' Attention, ça ne marche que si données d'entrées sont triée par date croissante (col A), sinon, il faut lz faire
For RowN = 2 To SrcRng.Rows.Count
 
    If IsDate(SrcRng(RowN, 1)) Then     'Peut être supprimé si c'est toujours une date
 
        DMonth = Month(SrcRng(RowN, 1)) ' On extrait le mois de la date, cf la sortie debug juste après
        Debug.Print RowN, SrcRng(RowN, 1), DMonth
 
        If DMonth = 4 Then 'Si c'est avril, on reset les compteur nb de valeurs et somme des valeurs
            CntVal = 0
            SumVal = 0
        End If
 
        CntVal = CntVal + 1 ' Dans tous les cas, on incrémente le compteur et la somme (pour le calcul de la moyenne)
        SumVal = SumVal + SrcRng(RowN, 7)
        SrcRng(RowN, 9) = SumVal / CntVal ' et on sort la moyenne sur la 9eme colonne du range (col "I")
 
    End If
 
Next RowN
 
End Sub

Bonne journée

[joel50]

Bonjour à tous

Merci Vincent

Ca marche super, c'est même plus que j’espérais, le code recalcule la colonne entière à chaque modif, alors que je pensais devoir repasser sur chaque lige individuellement en cas de modif sur une ligne du tableau qui n’était pas la dernière et adapté à mon tableur sans trop de mal avec les commentaires.

Je ne m’était jamais vraiment penché sur VBA auparavant, je ne soupçonnais pas une infime partie de ces capacités, de là à mettre en place les codes pour un néophyte, c'est autre chose, heureusement que les forums et surtout les contributeurs existent.
Excellent

Merci
Joël

[joel50]

Bonjour à tous
Je ré-ouvre mon post concernant cette partie de code.
Pas de souci, dans cette configuration, il fonctionne très bien.
Je m'aperçois cependant à l'utilisation sur mon classeur qu'il ne correspond pas à mon attente et me génère une erreur de calcul.
Dans mon classeur, la 1 ère colonne est bien chronologique mais pas régulière , c'est à dire qu'il y a une fiche (représentant une ligne) en moyenne tous les 2 mois, donc il arrive de passer de mars à mai, donc pas de remise à zéro en mois 4. Ou à l'inverse, il peut arrivé qu'il y est 2 ligne sur un même mois, donc 2 remise à zéro consécutive.
J'espère être à peu près clair.
Il faudrait que le base de la remise à zéro soit la colonne F dans l'exemple, comment doit je modifier mon code afin de changer la référence de départ?
Merci
Joël
Ci-dessous code fourni par Vinc_bilb que je ne parvient pas à adapter

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
 
Sub Test1()
 
Dim DMonth As Integer
Dim SrcRng As Range
Dim SumVal  As Double, CntVal As Integer
Dim RowN As Integer, ColN As Integer
 
Set SrcRng = ThisWorkbook.Worksheets("Données").Range("A3").CurrentRegion 'Ca revient à faire un CTLR+ * excel sur le range A3
CntVal = 0
SumVal = 0
 
' Attention, ça ne marche que si données d'entrées sont triée par date croissante (col A), sinon, il faut lz faire
For RowN = 2 To SrcRng.Rows.Count
 
    If IsDate(SrcRng(RowN, 1)) Then     'Peut être supprimé si c'est toujours une date
 
        DMonth = Month(SrcRng(RowN, 1)) ' On extrait le mois de la date, cf la sortie debug juste après
        Debug.Print RowN, SrcRng(RowN, 1), DMonth
 
        If DMonth = 4 Then 'Si c'est avril, on reset les compteur nb de valeurs et somme des valeurs
            CntVal = 0
            SumVal = 0
        End If
 
        CntVal = CntVal + 1 ' Dans tous les cas, on incrémente le compteur et la somme (pour le calcul de la moyenne)
        SumVal = SumVal + SrcRng(RowN, 7)
        SrcRng(RowN, 9) = SumVal / CntVal ' et on sort la moyenne sur la 9eme colonne du range (col "I")
 
    End If
 
Next RowN
 
End Sub

[vinc_bilb]

Dans mon classeur, la 1 ère colonne est bien chronologique mais pas régulière , c'est à dire qu'il y a une fiche (représentant une ligne) en moyenne tous les 2 mois, donc il arrive de passer de mars à mai, donc pas de remise à zéro en mois 4. Ou à l'inverse, il peut arrivé qu'il y est 2 ligne sur un même mois, donc 2 remise à zéro consécutive.
J'espère être à peu près clair.
Il faudrait que le base de la remise à zéro soit la colonne F dans l'exemple, comment doit je modifier mon code afin de changer la référence de départ?

Bonjour,

Je ne comprends pas tout ..... cf lignes 42 et 43 de votre exemple

3/1/2017	Blé	64	3	21.3	3/31/2017	13.70160273	Remise à réro
4/1/2017	fayots	66	2	33.1	3/31/2018	33.07959184	

=> Pourquoi la remise à Zéro intervient pour le 3/1/2017?
=> Est-ce-que l'on peut dire que, pour chaque année, la Remise à zéro intervient en avril, qu'il y ait un enregistrement ou non?

Bonne journée

[joel50]

Bonjour
Je me remet un peu sur mon projet, je n'ai pas pu y travailler depuis plusieurs jours.
Merci Vincent de t'intéresser à mon souci et de ton aide.

Pour la ligne 42, faute de ma part, j'ai copié dans la mauvaise cellule, la remise à zéro doit être à partir de la ligne 43.

Je serait tenté de répondre oui à la dernière question, tout au moins pour ce qui ce passe aujourd'hui.
Actuellement, la remise à zéro s'effectue chaque bien 1er avril, qu'il y est eu enregistrement ou non. La date indiquée en colonne F est la date de fin de campagne prise en compte par la suite dans mes calculs EXCEL.
Cependant, il est possible que cette date change un jour, par exemple campagne sur une année civile, donc remise à zéro au 1er janvier.

L'idéal serait que le code fasse la mise à zéro de la moyenne glissante au changement de date en colonne F, mais si pas possible une remise à chaque 1er avril me permettrai de boucler cette partie, en cas de changement de date charge à moi de remodifier ce code.
Mon besoin est de remplacer les formules EXCEL qui sont en colonnes L du fichier exemple, qui me génèrent des erreurs lors d'ajout et de suppression de ligne et que je doit modifier manuellement chaque année.

Ci-joint fichier exemple modifié.
Joël

[vinc_bilb]

Bonsoir,

ça devrait le faire, un peu à l'arrache mais testé ....

RefMonth contient le mois de référence (Avril ici)

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
Sub Test1()
 
Dim SrcRng As Range
Dim SumVal  As Double, CntVal As Integer
Dim RowN As Integer, ColN As Integer
Dim MinDate As Date, MaxDate As Date, DDate As Date, DYear As Integer
Dim DatRefAR() As Variant
Dim RefMonth As Integer, YearPart As Integer, YearCnt As Integer
 
' Init
Set SrcRng = ThisWorkbook.Worksheets("Données").Range("A3").CurrentRegion
RefMonth = 4    'à changer si besoin
 
' Extrait les dates min et max des  données
MinDate = WorksheetFunction.Min(SrcRng.Columns(1))
MaxDate = WorksheetFunction.Max(SrcRng.Columns(1))
 
' Crée un tableau contenant toutes les dates de référence
YearCnt = 0
ReDim DatRefAR(1 To (Year(MaxDate) - Year(MinDate)) + 1, 1 To 3)
 
For YearPart = Year(MinDate) To Year(MaxDate)
 
    YearCnt = YearCnt + 1
    DatRefAR(YearCnt, 1) = YearPart 'Année
    DatRefAR(YearCnt, 2) = DateSerial(YearPart, RefMonth, 1)
    DatRefAR(YearCnt, 3) = False    'Un Flag si trouvé, pour utilisation ultérieure
 
Next YearPart
 
' Init des valeurs
 
CntVal = 0
SumVal = 0
 
For RowN = 2 To SrcRng.Rows.Count
 
    If IsDate(SrcRng(RowN, 1)) Then     'Peut être supprimé si c'est toujours une date
 
        DDate = SrcRng(RowN, 1)
        DYear = Year(DDate)
 
        For YearCnt = 1 To UBound(DatRefAR, 1)
 
            ' Si l'année correspond
            If DYear = DatRefAR(YearCnt, 1) Then
 
                ' et si la date est postérieure à la référence, sans reset déjà effectué
                If DatRefAR(YearCnt, 3) = False And DDate >= DatRefAR(YearCnt, 2) Then
 
                    DatRefAR(YearCnt, 3) = True
                    CntVal = 0
                    SumVal = 0
                    SrcRng(RowN, 13) = "Reset"
                    Exit For
 
                End If
 
            End If
 
        Next YearCnt
        Debug.Print RowN, SrcRng(RowN, 1), DMonth
 
 
        CntVal = CntVal + 1
        SumVal = SumVal + SrcRng(RowN, 7)
        SrcRng(RowN, 14) = SumVal / CntVal
 
    End If
 
Next RowN
 
End Sub

[joel50]

Bonsoir
Merci Vincent
Je modifie mon dernier message, suite à l'intégration dans mon code perso, je m'aperçois que ne donne pas le bon résultat.
J'ai certainement mal adapté, et de plus je ne comprend pas certains éléments.
Par ex. j'ai modifié le code ci-dessous, pour lui demander de me mettre le résultat en colonne 7, il me rajoute un 0 dans les colonnes 9 et 10 (entre autre en lieu et place de ma formule EXCEL de la colonne 10).

Code :

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

1
2
 
        SrcRng(RowN, 7) = SumVal / CntVal ' et on sort la moyenne sur la 7eme colonne du range (col "G")

J'ai également modifié mon tableau de données dans l'exemple, plus proche de mon tableur de travail, peut être ce sera plus compréhensible.
Les remises à zéro, sont bien à faire au 1er avril, même s'il n'y a pas d'enregistrement en avril.

J'ai également tenter d'adapter le code sans succès en le basant sur la colonne 6 de l'exemple.

Joël

[vinc_bilb]

Bonsoir,

J'ai corrigé quelques points, pourriez-vous tester le module ci-joint, à mettre dans un module standard avant de l'intégrer si il vous semble OK?

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
Sub Test3()
 
Dim SrcRng As Range
Dim SumVal  As Double, CntVal As Integer
Dim RowN As Integer, ColN As Integer
Dim MinDate As Date, MaxDate As Date, DDate As Date, DYear As Integer
Dim DatRefAR() As Variant
Dim RefMonth As Integer, YearPart As Integer, YearCnt As Integer
 
' Init
Set SrcRng = ThisWorkbook.Worksheets("Données").Range("A3").CurrentRegion
Debug.Print SrcRng.Address
RefMonth = 4    'à changer si besoin
 
' Extrait les dates min et max des  données
MinDate = WorksheetFunction.Min(SrcRng.Columns(1))
MaxDate = WorksheetFunction.Max(SrcRng.Columns(1))
 
' Crée un tableau contenant toutes les dates de référence
YearCnt = 0
ReDim DatRefAR(1 To (Year(MaxDate) - Year(MinDate)) + 1, 1 To 3)
 
For YearPart = Year(MinDate) To Year(MaxDate)
 
    YearCnt = YearCnt + 1
    DatRefAR(YearCnt, 1) = YearPart 'Année
    DatRefAR(YearCnt, 2) = DateSerial(YearPart, RefMonth, 1)
    DatRefAR(YearCnt, 3) = False    'Un Flag si trouvé, pour utilisation ultérieure
 
Next YearPart
 
' Init des valeurs
 
CntVal = 0
SumVal = 0
 
For RowN = 2 To SrcRng.Rows.Count
 
    If IsDate(SrcRng(RowN, 1)) Then     'Peut être supprimé si c'est toujours une date
 
        DDate = SrcRng(RowN, 1)
        DYear = Year(DDate)
 
        For YearCnt = 1 To UBound(DatRefAR, 1)
 
            ' Si l'année correspond
            If DYear = DatRefAR(YearCnt, 1) Then
 
                ' et si la date est postérieure à la référence, sans reset déjà effectué
                If DatRefAR(YearCnt, 3) = False And DDate >= DatRefAR(YearCnt, 2) Then
 
                    DatRefAR(YearCnt, 3) = True
                    CntVal = 0
                    SumVal = 0
                    SrcRng(RowN, 8) = "RAZ"
                    Exit For
 
                End If
 
            End If
 
        Next YearCnt
 
        CntVal = CntVal + 1
        Debug.Print RowN, SrcRng(RowN, 5)
        SumVal = SumVal + SrcRng(RowN, 5)
        SrcRng(RowN, 7) = SumVal / CntVal
 
    End If
 
Next RowN
 
End Sub

[joel50]

Bonjour à tous
Merci Vincent pour ta modification, il semblerai que ce soit la bonne. En tous cas, le code fonctionne dans le tableur de test en module standard.
Ne me reste plus qu'a l'intégrer à mon tableur de travail, je vois si je l’intègre au code ou la laisse dans un module.

Juste une question, pour ma culture (très faible du VBA),
Au départ, j'étais parti avec l'idée d'écrire un code qui fasse la remise à zéro à partir de la colonne F du tableur avec RAZ si changement sur cette colonne. Mais, je ni suis pas arrivé et j'ai capitulé.
Sachant que j’étais bien incapable d'écrire le code que tu m'as fait, aurai-ce était plus compliqué, plus simple ou quasi-impossible de partir de données de la colonne F.

Je test dans mon tableur et je vous tiens au courant.

Merci
Joël

[vinc_bilb]

Bonsoir,

Nous progressons!
On peut faire le calcul à partir de n'importe quelle colonne, sans préjuger de la pertinence, Il suffit de modifier la partie

Code :

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

1
2
SumVal = SumVal + SrcRng(RowN, 5)
        SrcRng(RowN, 7) = SumVal / CntVal

où l'on prend la colonne 5 et on affiche sur la 7

Le plus compliqué pour moi là dedans a été de gérer la partie remise à zéro, sans, potentiellement, d'enregistrement au 01/04
Mais comme vous m'avez bien expliqué ...

[joel50]

Bonjour
Excellente progression.
C'est exactement ce qu'il me faut, intégré à mon tableur et fonctionne parfaitement, à voir sur la durée si pas de bug, j'ai testé quelques configurations, jusque qu'ici, tout est OK.
Encore Merci
Joël