Supprimez les extrêmes

Attention : pour suivre cet atelier, vous devez connaître un minimum de VBA, et savoir comment écrire une fonction personnalisée.

Vous avez déjà vu les compétitions sportives ou les juges doivent voter ? On retire les extrêmes, respectivement les notes les plus hautes et les plus basses.

Vous pouvez télécharger le classeur Excel qui contient les fonctions de cette rubrique ici.

Voici un petit exemple. Soit une compétition de plongeon, les juges donnent les notes suivantes :

9.5
8
9
9.5
7
7.5
8.5
9

 

La note la plus haute est 9.5
La note la plus basse est 7
La note la plus haute VALIDE est 9
La note la plus basse VALIDE est 7.5
La moyenne des notes valides est 8 + 9 + 7.5 + 8.5 + 9 = 42.   42 : 5 = 8.4

Ce qui serait extrêmement sympathique, c'est d'avoir une série de fonctions personnalisées qui permettent de calculer ces valeurs, comme ceci :

 
A
B
1
Juge belge
9.5
2
Juge suisse
8
3
Juge allemand
9
4
Juge suédois
9.5
5
Juge autrichien
7
6
Juge grec
7.5
7
Juge danois
8.5
8
Juge hollandais
9
9

MEILLEURE NOTE :

=SansExtremeMeilleur(B1:B8)
10

PIRE NOTE :

=SansExtremePire(B1:B8)
11
MOYENNE : =SansExtremeMoyenne(B1:B8)

Et qui donnerait le résultat suivant :

 
A
B
1
Juge belge
9.5
2
Juge suisse
8
3
Juge allemand
9
4
Juge suédois
9.5
5
Juge autrichien
7
6
Juge grec
7.5
7
Juge danois
8.5
8
Juge hollandais
9
9

MEILLEURE NOTE :

9
10

PIRE NOTE :

7.5
11
MOYENNE :
8.4

Il s'agit donc de construire 3 fonctions distinctes (SansExtremeMeilleur, SansExtremePire et SansExtremeMoyenne). Commençons par créer un nouveau module dans lequel nous créons :

Function SansExtremeMeilleur()
End Function

Notre fonction a besoin d'un paramètre particulier : c'est la plage de cellules qui contient les valeurs à juger. Ca se dit comme ceci :

Function SansExtremeMeilleur(LesNotes as Range)
End Function

Le fait d'écrire LesNotes as Range (LesNotes est une variable-paramètre sortie de mon imaginsation, qui est définie comme une variable de type "Range", c'est à dire une plage de cellules) permet de parcourir la plage de cellules. Dans notre exemple, la cellule B9 renverrait 9, parce que c'est la 3ème cellule du Range : (C'est à dire la note du juge allemand)

Function SansExtremeMeilleur(LesNotes as Range)
   SansExtremeMeilleur = LesNotes(3)
End Function

Si je voulais connaître le nombre de cellules comprises dans LesNotes, j'écrirais :

LesNotes.Count

Maintenant, pour connaître la meilleure note de manière absolue, on peut utiliser la fonction d'Excel bien connue : MAX. Et pour l'utiliser au sein de VBA, on va utiliser l'objet WorkSheetFunction, comme ceci :

Function SansExtremeMeilleur(LesNotes As Range)
  SansExtremeMeilleur = WorksheetFunction.Max(LesNotes)
End Function

Maintenant donc, toujours dans la cellule B9, dans notre exemple, le résultat serait 9.5. Bon, évidemment, c'est nul... on aurait tout aussi bien fait d'écrire directement =MAX(B1:B8) ! Il s'agit toujours d'éliminer les extrêmes.

Voici maintenant, pour s'approcher du but, une autre manière de repérer la meilleure note est de faire une boucle comme ceci :

Function SansExtremeMeilleur(LesNotes As Range)
  ' On commence par initialiser une variable à 0 :
  LaMeilleureNote = 0
  ' On parcourt la plage de cellule de la 1ère à la dernière cellule :  
  For Ctr = 1 To LesNotes.Count
   ' Si la note actuelle est plus grande que "LaMeilleureNote"
   ' Et lors du premier tour de boucle, ça va forcément être le
   ' Cas puisque "LaMeilleureNote" vaut 0), alors, "LaMeilleureNote"
   ' devient la note actuelle (dans notre exmeple 9.5)

   If LesNotes(Ctr) > LaMeilleureNote Then
      LaMeilleureNote = LesNotes(Ctr)
   End If

   ' Ensuite on repart dans la boucle avec la 2ème note, et si la
   ' 2ème est plus grande que 9.5, "LaMeilleureNote" va prendre la valeur
   ' de la 2ème note, mais ce n'est pas le cas (la 2ème vaut 8 dans notre
   ' exemple). En fait,
tout au long de la boucle, le 9.5 ne sera
   ' jamais détrôné...

  Next
   ' ... et donc le résultat de la fonction sera ... 9.5 :
  SansExtremeMeilleur = LaMeilleureNote
End Function

Toute cette complication pour avoir un résultat comparable à la fonction MAX ! Quelle injustice !!!

Mais en fait, maintenant, il n'y a plus grand chose à modifier pour la faire fonctionner correctement : il faut éliminer les plus grandes notes, c'est à dire les notes égales à WorksheetFunction.Max(LesNotes). Et ceci est assez simple, on va rajouter une 2ème condition :

Function SansExtremeMeilleur(LesNotes As Range)
  LaMeilleureNote = 0
  For Ctr = 1 To LesNotes.Count
    If LesNotes(Ctr) > LaMeilleureNote Then
      ' Ici : on précise que non seulement LesNotes(Ctr)
      ' doit être plus grand que "LaMeilleureNote", mais
      ' en plus, NE PAS être égal à la meilleure note :

      If LesNotes(Ctr) < WorksheetFunction.Max(LesNotes) Then
        LaMeilleureNote = LesNotes(Ctr)
      End If

    End If
  Next
  SansExtremeMeilleur = LaMeilleureNote
End Function

Et maintenant, le résultat est bien ... 9 !

La fonction inverse, c'est à dire SansExtremePireNote est tellement facile à créer que je crois qu'elle se passe de commentaire :

Function SansExtremePire(LesNotes As Range)
  ' On initialise LaPireNote à un chiffre très grand
  ' parce que si on la laisse à 0, il n'y aura jamais de note plus bas
  LaPireNote = 999999
  For Ctr = 1 To LesNotes.Count
    If LesNotes(Ctr) < LaPireNote Then
      If LesNotes(Ctr) > WorksheetFunction.Min(LesNotes) Then
        LaPireNote = LesNotes(Ctr)
      End If
    End If
  Next
  SansExtremePire = LaPireNote
End Function

La moyenne des notes intemédiaires ? Cette fois, il s'agit d'exclure les notes les plus hautes ET les plus basses, et de compter les notes intermédiaires (Dans notre exemple, il nous en reste 5 sur 8)

Function SansExtremeMoyenne(LesNotes As Range)
  ' Initialisation des variables :
  LaMeilleureNote = 0
  LaPireNote = 999999
  ' On a besoin de connaître le nombre de notes restantes :
  NombreNote = 0
  ' Et bien sûr le total des notes restantes :
  TotalNote = 0

  For Ctr = 1 To LesNotes.Count
    ' SI la note actuelle est plus petite que la plus grande :
    If LesNotes(Ctr) < WorksheetFunction.Max(LesNotes) Then
      ' ET si elle est plus grande que la plus petite (Vous suivez ?)
      If LesNotes(Ctr) > WorksheetFunction.Min(LesNotes) Then
        ' ALORS, c'est une note valide (non-extrême)
        ' Ca fait une note de plus :

        NombreNote = NombreNote + 1
        ' Et le total de ces notes augmente aussi :

        TotalNote = TotalNote + LesNotes(Ctr)
      End If
    End If
  Next
  ' Une fois la boucle terminée, on fait une bête division pour calculer
  ' la moyenne, comme à l'école : 
  SansExtremeMoyenne = TotalNote / NombreNote
End Function