[FAQ] Pour trouver le Minimum ou le Maximum

**ClaudeLELOUP** · 29/08/2010, 17h04

Bonjour,

Ces deux fonctions restituent le minimum ou le maximum d’une série de données, quel que soit leur nombre (illimité) et quel que soit leur type (date, numérique ou texte) pourvu qu’elles soient homogènes.
La série de données est présentée sous forme de texte, donc encadrée de quotes. Les composants sont séparés entre eux par un "PaillePeu" "|" = <alt> + 124
Pour le minimum :

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
Public Function LeMinimum(Série) As Variant
 'valeurs entre quotes et séparées par |
 'les nombres décimaux avec virgule.
 'le premier membre détermine le type de données (date, numérique ou texte)
 
 'ex d'appels :  LeMinimum("31/12/09|25/3/2003|1/1/07")
 '               LeMinimum("1000|4|5|3,1416")
 '               LeMinimum("abc|d|efg|h|a|bcd")
 '               LeMinimum("1000|abc|5|3,1416") conduit à une erreur
 '               LeMinimum("31/12/09|A|1/1/07") conduit à une erreur
 '               LeMinimum("a|abc|31/12/07|3,1416")sera accepté, _
                   mais les dates et nombres seront traités comme du texte
 
On Error GoTo erreur
Dim ArrSérie() As String, i As Integer
 
ArrSérie = Split(Série, "|")
LeMinimum = ArrSérie(0)
If IsDate(LeMinimum) Then   'comparaison de dates
 'vérifier homogénéité
 For i = 1 To UBound(ArrSérie)
   If Not IsDate(ArrSérie(i)) Then GoTo erreur
 Next i
 'Rechercher le plus petit
 For i = 1 To UBound(ArrSérie)
   If Format(ArrSérie(i), "yymmdd") < Format(LeMinimum, "yymmdd") Then
      LeMinimum = ArrSérie(i)
   End If
 Next i
Exit Function
ElseIf IsNumeric(LeMinimum) Then    'comparaison autre
 'vérifier homogénéité
 For i = 1 To UBound(ArrSérie)
   If Not IsNumeric(ArrSérie(i)) Then GoTo erreur
 Next i
 'Rechercher le plus petit
 
 For i = 1 To UBound(ArrSérie)
   If CDbl(ArrSérie(i)) < CDbl(LeMinimum) Then
      LeMinimum = ArrSérie(i)
   End If
 Next i
Exit Function
Else
 For i = 1 To UBound(ArrSérie)
   If ArrSérie(i) < LeMinimum Then
      LeMinimum = ArrSérie(i)
   End If
 Next i
End If
Exit Function
 
erreur:
MsgBox "les données ne sont pas homogènes", vbCritical
 
End Function

Pour le maximum :

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
Public Function LeMaximum(Série) As Variant
 'valeurs entre quotes et séparées par |
 'les nombres décimaux avec virgule.
 'le premier membre détermine le type de données (date, numérique ou texte)
 
 'ex d'appels :  LeMaximum("31/12/09|25/3/2003|1/1/07")
 '               LeMaximum("1000|4|5|3,1416")
 '               LeMaximum("abc|d|efg|h|a|bcd")
 '               LeMaximum("1000|abc|5|3,1416") conduit à une erreur
 '               LeMaximum("31/12/09|A|1/1/07") conduit à une erreur '               LeMaximum("a|abc|31/12/07|3,1416")sera accepté, _
                   mais les dates et nombres seront traités comme du texte
 
On Error GoTo erreur
Dim ArrSérie() As String, i As Integer
 
ArrSérie = Split(Série, "|")
LeMaximum = ArrSérie(0)
If IsDate(LeMaximum) Then   'comparaison de dates
 'vérifier homogénéité
 For i = 1 To UBound(ArrSérie)
   If Not IsDate(ArrSérie(i)) Then GoTo erreur
 Next i
 'Rechercher le plus Grand
 For i = 1 To UBound(ArrSérie)
   If Format(ArrSérie(i), "yymmdd") > Format(LeMaximum, "yymmdd") Then
      LeMaximum = ArrSérie(i)
   End If
 Next i
Exit Function
ElseIf IsNumeric(LeMaximum) Then 'comparaison autre
 'vérifier homogénéité
 For i = 1 To UBound(ArrSérie)
   If Not IsNumeric(ArrSérie(i)) Then GoTo erreur
 Next i
 'Rechercher le plus Grand
 For i = 1 To UBound(ArrSérie)
   If CDbl(ArrSérie(i)) > CDbl(LeMaximum) Then
      LeMaximum = ArrSérie(i)
   End If
 Next i
Exit Function
Else
 For i = 1 To UBound(ArrSérie)
   If ArrSérie(i) > LeMaximum Then
      LeMaximum = ArrSérie(i)
   End If
 Next i
End If
Exit Function
 
erreur:
MsgBox "les données ne sont pas homogènes", vbCritical
 
End Function

Exemple d'utilisation dans une requête
sur "DatesAcomparer" pour les champs date1, date2, date3 et date4

Code :

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

1
2
SELECT DatesAcomparer.date1, DatesAcomparer.date2, DatesAcomparer.date3, DatesAcomparer.date4, LeMinimum([date1] & "|" & [date2] & "|" & [date3] & "|" & [date4]) AS [Min], LeMaximum([date1] & "|" & [date2] & "|" & [date3] & "|" & [date4]) AS [Max]
FROM DatesAcomparer;

**Jean-Philippe André** · 05/09/2010, 01h21

salut,
une bien belle utilisation de la fonction Split()

Puis-je te proposer de code sur le meme modele le tri croissant et décroissant ?

Dans quel cadre as-tu eu l'occasion de mettre en place cette fonction ?

**ClaudeLELOUP** · 08/09/2010, 20h15

Bonjour jpcheck,

Quelques jours de vacances expliquent ma réponse tardive.

Puis-je te proposer de code sur le meme modele le tri croissant et décroissant ?

Je ne comprends pas la question.
S'agit-il de trier la série et la restituer présentée dans l'ordre croissant ?

Dans quel cadre as-tu eu l'occasion de mettre en place cette fonction ?

La question d'un visiteur.
http://www.developpez.net/forums/d96...sieurs-champs/

**Jean-Philippe André** · 09/09/2010, 09h57

Salut,
exactement, il s'agit de trier dans l'ordre souhaite les valeurs de ta serie.

Tri a bulle ou autre algorithme possible

**ClaudeLELOUP** · 09/09/2010, 15h47

ReBonjour jpcheck,

Une variante sous forme de couteau suisse.
Pour le même prix, au choix : l'ordre croissant, décroissant, le Max ou le Min.

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
98
99
100
101
102
Public Function TriABulle(Série As String, Optional ChoixRésultat As String = "Croissant")
' Tri à bulle --->http://lwh.free.fr/pages/algo/tri/tri_bulle.htm
 
 '1er paramètre
 '-------------
 'valeurs entre quotes et séparées par |, "PaillePeu ou pipe" = <alt> + 124
 'les nombres décimaux avec virgule.
 'le premier membre détermine le type de données (date, numérique ou texte)
 '2ème paramètre :
 '--------------
 '  "Croissant" (par défaut) la fonction renvoie la série dans l'ordre croissant
 '  "Décroissant" la fonction renvoie la série dans l'ordre décroissant
 '  "Max" la fonction renvoie le maximum dans la série
 '  "Min" la fonction renvoie le minimum dans la série
 'ex d'appels :  TriABulle("31/12/09|25/3/2003|1/1/07","Décroissant")
 '-----------    TriABulle("1000|4|5|3,1416") ---> ordre croissant
 '               TriABulle("abc|d|efg|h|a|bcd","Max")
 '               TriABulle("1000|abc|5|3,1416") conduit à une erreur
 '               TriABulle("31/12/09|A|1/1/07") conduit à une erreur
 '               TriABulle("a|abc|31/12/07|3,1416")sera accepté, _
                   mais les dates et nombres seront traités comme du texte
 
On Error GoTo erreur
Dim ArrSérie() As String, i As Integer, Permuté As Boolean, Tampon As Variant
 
ArrSérie = Split(Série, "|")
Permuté = True
If IsDate(ArrSérie(0)) Then   'comparaison de dates
 'vérifier homogénéité
   For i = 1 To UBound(ArrSérie)
       If Not IsDate(ArrSérie(i)) Then GoTo erreur
   Next i
 'classer en ordre croissant par permutations successives
   Do While Permuté = True
       Permuté = False
         For i = 0 To UBound(ArrSérie) - 1
               If Format(ArrSérie(i), "yymmdd") > Format(ArrSérie(i + 1), "yymmdd") Then
                    Tampon = ArrSérie(i + 1)
                    ArrSérie(i + 1) = ArrSérie(i)
                    ArrSérie(i) = Tampon
                    Permuté = True
               End If
         Next i
    Loop
ElseIf IsNumeric(ArrSérie(0)) Then   'comparaison de numériques
 'vérifier homogénéité
   For i = 1 To UBound(ArrSérie)
       If Not IsNumeric(ArrSérie(i)) Then GoTo erreur
   Next i
 'classer en ordre croissant par permutations successives
   Do While Permuté = True
       Permuté = False
         For i = 0 To UBound(ArrSérie) - 1
               If CDbl(ArrSérie(i)) > CDbl(ArrSérie(i + 1)) Then
                    Tampon = ArrSérie(i + 1)
                    ArrSérie(i + 1) = ArrSérie(i)
                    ArrSérie(i) = Tampon
                    Permuté = True
               End If
         Next i
    Loop
Else     ' comparaison texte
   Do While Permuté = True
       Permuté = False
         For i = 0 To UBound(ArrSérie) - 1
               If ArrSérie(i) > ArrSérie(i + 1) Then
                    Tampon = ArrSérie(i + 1)
                    ArrSérie(i + 1) = ArrSérie(i)
                    ArrSérie(i) = Tampon
                    Permuté = True
               End If
         Next i
    Loop
 
End If
 
AménagerRésultat:
Select Case ChoixRésultat
Case "Croissant"
   For i = 0 To UBound(ArrSérie)
     TriABulle = TriABulle & ArrSérie(i) & "|"
   Next i
   TriABulle = Left(TriABulle, Len(TriABulle) - 1)
Case "Décroissant"
   For i = UBound(ArrSérie) To 0 Step -1
     TriABulle = TriABulle & ArrSérie(i) & "|"
   Next i
   TriABulle = Left(TriABulle, Len(TriABulle) - 1)
Case "Max"
   TriABulle = ArrSérie(UBound(ArrSérie))
Case "Min"
   TriABulle = ArrSérie(0)
Case Else
   MsgBox "Ce paramètre de choix n'est pas prévu", vbCritical
   Exit Function
 
End Select
Exit Function
 
erreur:
MsgBox "les données ne sont pas homogènes", vbCritical
End Function

Exemple d'utilisation dans une requête
sur "DatesAcomparer" pour les champs date1, date2, date3 et date4

Code :

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

1
2
SELECT DatesAcomparer.date1, DatesAcomparer.date2, DatesAcomparer.date3, DatesAcomparer.date4, TriABulle([date1] & "|" & [date2] & "|" & [date3] & "|" & [date4],"Min") AS [Min], TriABulle([date1] & "|" & [date2] & "|" & [date3] & "|" & [date4],"Max") AS [Max], TriABulle([date1] & "|" & [date2] & "|" & [date3] & "|" & [date4],"Décroissant") AS Décroissant, TriABulle([date1] & "|" & [date2] & "|" & [date3] & "|" & [date4]) AS Croissant
FROM DatesAcomparer;

**ClaudeLELOUP** · 28/09/2010, 21h53

Bonsoir
Une variante de la précédente.
Le résultat de la fonction est un type défini par l'utilisateur.
(à copier en début de module)

Code :

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

1
2
3
4
5
6
Type ResultatTri
    Min As Variant
    Max As Variant
    Asc As String
    Desc As String
End Type

Type Variant pour Min et Max, car on ne connaît pas le type a priori.

La syntaxe d’appel devient

Tri("31/12/09|25/3/2003|1/1/07").asc
Tri("1000|4|5|3,1416").desc
Tri("abc|d|efg|h|a|bcd").max
Tri("abc|d|efg|h|a|bcd").min

L’avantage : 1 seul argument (la série à trier) et Access suggère les valeurs possibles des choix du résultat.

La fonction devient :

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
Public Function Tri(Serie As String) As ResultatTri
' Tri à bulle --->http://lwh.free.fr/pages/algo/tri/tri_bulle.htm
 
 ' paramètre
 '-------------
 'valeurs entre quotes et séparées par |, "PaillePeu ou pipe" = <alt> + 124
 'les nombres décimaux avec virgule.
 'le premier membre détermine le type de données (date, numérique ou texte)
  'ex d'appels : Tri("31/12/09|25/3/2003|1/1/07").asc
 '-----------    Tri("1000|4|5|3,1416").desc
 '               Tri("abc|d|efg|h|a|bcd").max
 '               Tri("1000|abc|5|3,1416").min ---> conduit à une erreur
 '               Tri("31/12/09|A|1/1/07").min ---> conduit à une erreur
 '               Tri("a|abc|31/12/07|3,1416").asc   sera accepté, _
                   mais les dates et nombres seront traités comme du texte
 
On Error GoTo erreur
Dim ArrSerie() As String, i As Integer, Permute As Boolean, Tampon As Variant
 
ArrSerie = Split(Serie, "|")
Permute = True
If IsDate(ArrSerie(0)) Then   'comparaison de dates
 'vérifier homogénéité
   For i = 1 To UBound(ArrSerie)
       If Not IsDate(ArrSerie(i)) Then GoTo erreur
   Next i
 'classer en ordre croissant par permutations successives
   Do While Permute = True
       Permute = False
         For i = 0 To UBound(ArrSerie) - 1
               If Format(ArrSerie(i), "yymmdd") > Format(ArrSerie(i + 1), "yymmdd") Then
                    Tampon = ArrSerie(i + 1)
                    ArrSerie(i + 1) = ArrSerie(i)
                    ArrSerie(i) = Tampon
                    Permute = True
               End If
         Next i
    Loop
ElseIf IsNumeric(ArrSerie(0)) Then   'comparaison de numériques
 'vérifier homogénéité
   For i = 1 To UBound(ArrSerie)
       If Not IsNumeric(ArrSerie(i)) Then GoTo erreur
   Next i
 'classer en ordre croissant par permutations successives
   Do While Permute = True
       Permute = False
         For i = 0 To UBound(ArrSerie) - 1
               If CDbl(ArrSerie(i)) > CDbl(ArrSerie(i + 1)) Then
                    Tampon = ArrSerie(i + 1)
                    ArrSerie(i + 1) = ArrSerie(i)
                    ArrSerie(i) = Tampon
                    Permute = True
               End If
         Next i
    Loop
Else     ' comparaison texte
   Do While Permute = True
       Permute = False
         For i = 0 To UBound(ArrSerie) - 1
               If ArrSerie(i) > ArrSerie(i + 1) Then
                    Tampon = ArrSerie(i + 1)
                    ArrSerie(i + 1) = ArrSerie(i)
                    ArrSerie(i) = Tampon
                    Permute = True
               End If
         Next i
    Loop
 
End If
'AmenagerResultat:
'Croissant
   For i = 0 To UBound(ArrSerie)
     Tri.Asc = Tri.Asc & ArrSerie(i) & "|"
   Next i
   Tri.Asc = Left(Tri.Asc, Len(Tri.Asc) - 1)
'Décroissant
   For i = UBound(ArrSerie) To 0 Step -1
     Tri.Desc = Tri.Desc & ArrSerie(i) & "|"
   Next i
   Tri.Desc = Left(Tri.Desc, Len(Tri.Desc) - 1)
'Max
   Tri.Max = ArrSerie(UBound(ArrSerie))
'Min
   Tri.Min = ArrSerie(0)
Exit Function
erreur:
MsgBox "les données ne sont pas homogènes", vbCritical
End Function

Merci déjà pour remarques et suggestions.

[FAQ] Pour trouver le Minimum ou le Maximum

Contribuez

Vue hybride

Discussions similaires

Partager

Partager