Discussion :

[mia73]

Bonjour à tous,


j'ai de nouveau besoin de votre aide, cette fois-ci pour la céation d'une macro. Je ne suis pas une pro de la programmation et je ne connais que très peu le langage VBA (je commence tout juste à m'y mettre); du coup je suis en grande galère !

Je vais donc vous expliquer ce que je souhaiterais faire et peut-être pourrez-vous m'aider à construire une macro, si vous le voulez bien.

Je cherche en fait à calculer une moyenne de certaines valeurs d'une colonne "Valeurs" en fonction du contenu texte d'une autre colonne "Intitulés". Je vous ai mis un exemple ci-dessous afin que cela soit un peu plus clair.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Intitulés                  Valeurs              Moyenne             Différence
arrosage 1               23                     49.67                  0
arrosage 1               100                   49.67                  50.33
arrosage 1               26                     49.67                  0
arrosage 2               14                     15.25                  0 
arrosage 2               12                     15.25                  0
arrosage 2               16                     15.25                  0
arrosage 2               19                     15.25                  0
fontaine                 52                      54                    0
fontaine                 56                      54                    0
WC                       12                      11                    0
WC                       11                      11                    0
WC                       10                      11                    0

La macro doit ainsi me permettre de compléter automatiquement la colonne "Moyenne" ainsi que la colonne "Différence" que je vais de suite vous expliquer.

Pour remplir la colonne "Différence", je teste si, pour un intitulé donné, les plus grandes valeur de la 2e colonne sont supérieures à 2 fois la moyenne calculée. Par exemple pour l'arrosage 1, "100" est plus de 2 fois supérieur à 49.67. Il faudrait ensuite que la macro teste la 2e plus grande valeur, jusqu'à ce que la plus grande valeur de ne soit plus 2 fois plus grande que la moyenne. Dans mon exemple, pour l'arrosage 1, il n'y a que 100 (la 2e plus grande valeur, 26, n'est pas 2 fois plus grande que la moyenne).
Et donc dans "Différence" la macro rentrerait la différence entre la plus grande valeur et la moyenne (100-49.67=50.33). Si la plus grande valeur n'est pas 2 fois supérieur à la moyenne, on rentre "0".

Pour que vous imaginiez ma galère, je vais vous montrer à quoi peut ressembler mon embryon de code, si on peut appeler ça un code

Code :

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

1
2
3
4
5
For ligne = 2 to ligne = dernière_cellule
While cells(ligne + 1, "A") = cells(ligne, "A") Then
Cells (ligne, "C") = Moyenne ((cells(ligne, "B"):cells(ligne+1, "B"))
ligne = ligne + 1
Wend

Je sais qu'il y a des erreurs d'écriture mais c'est tt ce que j'ai réussi à pondre ! Après je ne sais pas comment rajouter la partie calculant "Différence".

Voilà donc mon challenge, votre challenge en fait maintenant

J'espère que vous avez compris la chose, autrement n'hésitez pas à me demander des éclaircissements !

Un grand merci pour votre attention

[mia73]

Finalement je vais utiliser un autre moyen de mettre en évidence mes consommations extrêmes. Plutôt que de prendre comme valeur seuil 2 fois la moyenne, je vais prendre la moyenne + 3 fois l'écart-type [ avec écart-type = (grande.valeur - petite.valeur)/(nb de valeurs) ]
Mais sur le fond ça ne change pas le problème.

[mercatog]

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
Private Sub CommandButton1_Click()
Dim LastLig As Long, i As Long
Dim Moy As Double, EcTp As Double
Dim Intit As New Collection
Dim Plage As Range, c As Range
 
Application.ScreenUpdating = False
With Sheets("Feuil4")                   ' à adapter
    LastLig = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To LastLig
        On Error Resume Next
            Intit.Add .Range("A" & i).Value, .Range("A" & i).Value
        On Error GoTo 0
    Next i
    For i = 1 To Intit.Count
        With .Range("A1:D" & LastLig)
            .AutoFilter
            .AutoFilter field:=1, Criteria1:=Intit(i)
        End With
        Set Plage = .Range("B2:B" & LastLig).SpecialCells(xlCellTypeVisible)
            Moy = Application.Average(Plage)    'Moyenne
            EcTp = Application.StDev(Plage)     'Ecartype
            .Range("C2:C" & LastLig).SpecialCells(xlCellTypeVisible).Value = Moy
            For Each c In Plage
                c.Offset(0, 2) = IIf(c.Value >= 2 * Moy, c.Value - Moy, 0)
                'c.Offset(0, 2) = IIf(c.Value >= Moy + 3 * EcTp, c.Value - Moy, 0)
            Next c
        Set Plage = Nothing
        .Range("A1:D" & LastLig).AutoFilter
    Next i
    Set Intit = Nothing
End With
End Sub

Si commentaire n'est pas nécessaire

[mia73]

Bonjour,

merci beaucoup ! cela fonctionne très bien sauf pour un petit détail : lorsqu'il n'y a qu'un seul intitulé du même type (par exemple si je n'ai qu'une seule "fontaine" au lieu de deux), cela bug. Comme j'ai quelques difficultés à bien comprendre le code, je n'arrive pas à le modifier pour prendre en compte ce cas-là.

[mercatog]

Effectivement, remplace la ligne de l'écart type

Code :

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

EcTp = IIf(Plage.Count = 1, Plage.Value, Application.StDev(Plage)) 'Ecartype

[mia73]

c'est parfait